home *** CD-ROM | disk | FTP | other *** search
/ Giga Games 1 / Giga Games.iso / net / usenet / volume2 / dungeon / part04 < prev    next >
Encoding:
Internet Message Format  |  1987-09-02  |  55.3 KB
  1. Path: uunet!seismo!ut-sally!im4u!rutgers!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games-request
  2. From: games-request@tekred.TEK.COM
  3. Newsgroups: comp.sources.games
  4. Subject: v02i037:  dungeon - game of adventure, Part04/14
  5. Message-ID: <1560@tekred.TEK.COM>
  6. Date: 1 Sep 87 20:18:39 GMT
  7. Sender: billr@tekred.TEK.COM
  8. Lines: 2653
  9. Approved: billr@tekred.TEK.COM
  10.  
  11. Submitted by: Bill Randle <games-request@tekred.TEK.COM>
  12. Comp.sources.games: Volume 2, Issue 37
  13. Archive-name: dungeon/Part04
  14.  
  15. #! /bin/sh
  16. # This is a shell archive.  Remove anything before this line, then unpack
  17. # it by saving it into a file and typing "sh file".  To overwrite existing
  18. # files, type "sh file -c".  You can also feed this as standard input via
  19. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  20. # will see the following message at the end:
  21. #        "End of archive 4 (of 7)."
  22. # Contents:  clock.h dverb2.F gdt.F lex.c nobjs.F sverbs.F
  23. # Wrapped by billr@tekred on Tue Apr 21 10:24:29 1987
  24. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  25. if test -f clock.h -a "${1}" != "-c" ; then 
  26.   echo shar: Will not over-write existing file \"clock.h\"
  27. else
  28. echo shar: Extracting \"clock.h\" \(339 characters\)
  29. sed "s/^X//" >clock.h <<'END_OF_clock.h'
  30. XC
  31. XC CLOCK INTERRUPTS
  32. XC
  33. X    LOGICAL CFLAG
  34. X    COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  35. XC
  36. X    COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
  37. X&        CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
  38. X&        CEVGNO,CEVBUC,CEVSPH,CEVEGH,
  39. X&        CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
  40. X&        CEVMRS,CEVPIN,CEVINQ,CEVFOL
  41. X    INTEGER EQC(25,2)
  42. X    EQUIVALENCE (CTICK, EQC)
  43. END_OF_clock.h
  44. if test 339 -ne `wc -c <clock.h`; then
  45.     echo shar: \"clock.h\" unpacked with wrong size!
  46. fi
  47. # end of overwriting check
  48. fi
  49. if test -f dverb2.F -a "${1}" != "-c" ; then 
  50.   echo shar: Will not over-write existing file \"dverb2.F\"
  51. else
  52. echo shar: Extracting \"dverb2.F\" \(10970 characters\)
  53. sed "s/^X//" >dverb2.F <<'END_OF_dverb2.F'
  54. XC SAVE- SAVE GAME STATE
  55. XC
  56. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  57. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  58. XC WRITTEN BY R. M. SUPNIK
  59. XC
  60. XC DECLARATIONS
  61. XC
  62. X    SUBROUTINE SAVEGM
  63. X    IMPLICIT INTEGER (A-Z)
  64. X#include "parser.h"
  65. X#include "gamestate.h"
  66. X#include "state.h"
  67. X#include "screen.h"
  68. X#include "puzzle.h"
  69. X#include "rooms.h"
  70. X#include "exits.h"
  71. X#include "objects.h"
  72. X#include "clock.h"
  73. X#include "villians.h"
  74. X#include "advers.h"
  75. X#include "flags.h"
  76. XC
  77. XC MISCELLANEOUS VARIABLES
  78. XC
  79. X    COMMON /VERS/ VMAJ,VMIN,VEDIT
  80. X    COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  81. XC
  82. X    PRSWON=.FALSE.
  83. XC                        !DISABLE GAME.
  84. XC Note: save file format is different for PDP vs. non-PDP versions
  85. XC
  86. X#ifdef PDP
  87. XC
  88. XC    send restore data flag down pipe
  89. XC
  90. X    call outstr(stchr,1)
  91. X
  92. XC    write out necessary common blocks
  93. XC
  94. XC    /play/
  95. X    call arywt(4,winner)
  96. XC
  97. XC    /state/
  98. X    call arywt(11,moves)
  99. XC
  100. XC    /screen/
  101. X    call arywt(3,formdr)
  102. XC
  103. XC    /puzzle/
  104. X    call arywt(64,cpvec)
  105. XC
  106. XC    /vers/
  107. X    call arywt(3,vmaj)
  108. XC
  109. XC    /rooms/
  110. X    call arywt(400,rval)
  111. XC
  112. XC    /objects/
  113. X    call arywt(2860,odesc1)
  114. XC
  115. XC    /cevent/
  116. X    call arywt(100,ctick)
  117. XC
  118. XC    /hack/
  119. X    call arywt(8,thfpos)
  120. XC
  121. XC    /vill/
  122. X    call arywt(4,vprob)
  123. XC
  124. XC    /advs/
  125. X    call arywt(28,aroom)
  126. XC
  127. XC    /findex/
  128. X    call arywt(114,flags)
  129. XC
  130. XC    send end of data flag down pipe
  131. XC
  132. X    call outstr(endchr,1)
  133. X    CALL RSPEAK(597)
  134. X    RETURN
  135. X#else
  136. X    OPEN (UNIT=1,file='dsave.dat',ACCESS='SEQUENTIAL',
  137. X&        status='UNKNOWN',FORM='UNFORMATTED',ERR=100)
  138. XC
  139. X    CALL GTTIME(I)
  140. XC                        !GET TIME.
  141. X    WRITE(1) VMAJ,VMIN,VEDIT
  142. X    WRITE(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
  143. X&        SWDACT,SWDSTA,CPVEC
  144. X    WRITE(1) I,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
  145. X&        LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
  146. X    WRITE(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
  147. X&        OSIZE,OCAPAC,OROOM,OADV,OCAN
  148. X    WRITE(1) RVAL,RFLAG
  149. X    WRITE(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
  150. X    WRITE(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK
  151. XC
  152. X    CLOSE(UNIT=1)
  153. X    CALL RSPEAK(597)
  154. X    RETURN
  155. XC
  156. X100    CALL RSPEAK(598)
  157. XC                        !CANT DO IT.
  158. X    RETURN
  159. X#endif PDP
  160. X    END
  161. XC RESTORE- RESTORE GAME STATE
  162. XC
  163. XC DECLARATIONS
  164. XC
  165. X    SUBROUTINE RSTRGM
  166. X    IMPLICIT INTEGER (A-Z)
  167. X#include "parser.h"
  168. X#include "gamestate.h"
  169. X#include "state.h"
  170. X#include "screen.h"
  171. X#include "puzzle.h"
  172. X#include "rooms.h"
  173. X#include "exits.h"
  174. X#include "objects.h"
  175. X#include "clock.h"
  176. X#include "villians.h"
  177. X#include "advers.h"
  178. X#include "flags.h"
  179. XC
  180. XC MISCELLANEOUS VARIABLES
  181. XC
  182. X    COMMON /VERS/ VMAJ,VMIN,VEDIT
  183. X    COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  184. XC
  185. X    PRSWON=.FALSE.
  186. XC                        !DISABLE GAME.
  187. XC Note: save file format is different for PDP vs. non-PDP versions
  188. XC
  189. X#ifdef PDP
  190. XC
  191. XC    read in necessary common blocks
  192. XC
  193. XC    /play/
  194. X    call aryrd(4,winner)
  195. XC
  196. XC    /state/
  197. X    call aryrd(11,moves)
  198. XC
  199. XC    /screen/
  200. X    call aryrd(3,formdr)
  201. XC
  202. XC    /puzzle/
  203. X    call aryrd(64,cpvec)
  204. XC
  205. XC    /vers/
  206. X    call intrd(i)
  207. X    call intrd(j)
  208. X    call intrd(k)
  209. XC
  210. XC    /rooms/
  211. X    call aryrd(400,rval)
  212. XC
  213. XC    /objects/
  214. X    call aryrd(2860,odesc1)
  215. XC
  216. XC    /cevent/
  217. X    call aryrd(100,ctick)
  218. XC
  219. XC    /hack/
  220. X    call aryrd(8,thfpos)
  221. XC
  222. XC    /vill/
  223. X    call aryrd(4,vprob)
  224. XC
  225. XC    /advs/
  226. X    call aryrd(28,aroom)
  227. XC
  228. XC    /findex/
  229. X    call aryrd(114,flags)
  230. XC
  231. X
  232. XC
  233. X     IF(or((I.NE.VMAJ),(J.NE.VMIN))) GO TO 200
  234. X    CALL RSPEAK(599)
  235. X    RETURN
  236. XC
  237. X200    CALL RSPEAK(600)            
  238. XC                        !OBSOLETE VERSION
  239. X    RETURN
  240. X#else
  241. X    OPEN (UNIT=1,file='dsave.dat',ACCESS='SEQUENTIAL',
  242. X&        status='OLD',FORM='UNFORMATTED',ERR=100)
  243. XC
  244. X    READ(1) I,J,K
  245. X    IF(or((I.NE.VMAJ),(J.NE.VMIN))) GO TO 200
  246. XC
  247. X    READ(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
  248. X&        SWDACT,SWDSTA,CPVEC
  249. X    READ(1) PLTIME,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
  250. X&        LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
  251. X    READ(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
  252. X&        OSIZE,OCAPAC,OROOM,OADV,OCAN
  253. X    READ(1) RVAL,RFLAG
  254. X    READ(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
  255. X    READ(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK
  256. XC
  257. X    CLOSE(UNIT=1)
  258. X    CALL RSPEAK(599)
  259. X    RETURN
  260. XC
  261. X100    CALL RSPEAK(598)
  262. XC                        !CANT DO IT.
  263. X    RETURN
  264. XC
  265. X200    CALL RSPEAK(600)
  266. XC                        !OBSOLETE VERSION
  267. X    CLOSE (UNIT=1)
  268. X    RETURN
  269. X#endif PDP
  270. X    END
  271. XC WALK- MOVE IN SPECIFIED DIRECTION
  272. XC
  273. XC DECLARATIONS
  274. XC
  275. X    LOGICAL FUNCTION WALK(X)
  276. X    IMPLICIT INTEGER(A-Z)
  277. X    LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMDESC
  278. X#include "parser.h"
  279. X#include "gamestate.h"
  280. X#include "rooms.h"
  281. X#include "rflag.h"
  282. X#include "curxt.h"
  283. X#include "xsrch.h"
  284. X#include "objects.h"
  285. X#include "oflags.h"
  286. X#include "clock.h"
  287. X
  288. X#include "villians.h"
  289. X#include "advers.h"
  290. X#include "flags.h"
  291. XC
  292. XC FUNCTIONS AND DATA
  293. XC
  294. X    QOPEN(O)=and(OFLAG2(O),OPENBT).NE.0
  295. XC WALK, PAGE 2
  296. XC
  297. X    WALK=.TRUE.
  298. XC                        !ASSUME WINS.
  299. X    IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25,25))
  300. X&        GO TO 500
  301. X    IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450
  302. XC                        !INVALID EXIT? GRUE
  303. XC                        !
  304. X    GO TO (400,200,100,300),XTYPE
  305. XC                        !DECODE EXIT TYPE.
  306. X    CALL BUG(9,XTYPE)
  307. XC
  308. X100    IF(CXAPPL(XACTIO).NE.0) GO TO 400
  309. XC                        !CEXIT... RETURNED ROOM?
  310. X    IF(FLAGS(XFLAG)) GO TO 400
  311. XC                        !NO, FLAG ON?
  312. X200    CALL JIGSUP(523)
  313. XC                        !BAD EXIT, GRUE
  314. XC                        !
  315. X    RETURN
  316. XC
  317. X300    IF(CXAPPL(XACTIO).NE.0) GO TO 400
  318. XC                        !DOOR... RETURNED ROOM?
  319. X    IF(QOPEN(XOBJ)) GO TO 400
  320. XC                        !NO, DOOR OPEN?
  321. X    CALL JIGSUP(523)
  322. XC                        !BAD EXIT, GRUE
  323. XC                        !
  324. X    RETURN
  325. XC
  326. X400    IF(LIT(XROOM1)) GO TO 900
  327. XC                        !VALID ROOM, IS IT LIT?
  328. X450    CALL JIGSUP(522)
  329. XC                        !NO, GRUE
  330. XC                        !
  331. X    RETURN
  332. XC
  333. XC ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE).
  334. XC
  335. X500    IF(FINDXT(PRSO,HERE)) GO TO 550
  336. XC                        !EXIT EXIST?
  337. X525    XSTRNG=678
  338. XC                        !ASSUME WALL.
  339. X    IF(PRSO.EQ.XUP) XSTRNG=679
  340. XC                        !IF UP, CANT.
  341. X    IF(PRSO.EQ.XDOWN) XSTRNG=680
  342. XC                        !IF DOWN, CANT.
  343. X    IF(and(RFLAG(HERE),RNWALL).NE.0) XSTRNG=524
  344. X    CALL RSPEAK(XSTRNG)
  345. X    PRSCON=1
  346. XC                        !STOP CMD STREAM.
  347. X    RETURN
  348. XC
  349. X550    GO TO (900,600,700,800),XTYPE
  350. XC                        !BRANCH ON EXIT TYPE.
  351. X    CALL BUG(9,XTYPE)
  352. XC
  353. X700    IF(CXAPPL(XACTIO).NE.0) GO TO 900
  354. XC                        !CEXIT... RETURNED ROOM?
  355. X    IF(FLAGS(XFLAG)) GO TO 900
  356. XC                        !NO, FLAG ON?
  357. X600    IF(XSTRNG.EQ.0) GO TO 525
  358. XC                        !IF NO REASON, USE STD.
  359. X    CALL RSPEAK(XSTRNG)
  360. XC                        !DENY EXIT.
  361. X    PRSCON=1
  362. XC                        !STOP CMD STREAM.
  363. X    RETURN
  364. XC
  365. X800    IF(CXAPPL(XACTIO).NE.0) GO TO 900
  366. XC                        !DOOR... RETURNED ROOM?
  367. X    IF(QOPEN(XOBJ)) GO TO 900
  368. XC                        !NO, DOOR OPEN?
  369. X    IF(XSTRNG.EQ.0) XSTRNG=525
  370. XC                        !IF NO REASON, USE STD.
  371. X    CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
  372. X    PRSCON=1
  373. XC                        !STOP CMD STREAM.
  374. X    RETURN
  375. XC
  376. X900    WALK=MOVETO(XROOM1,WINNER)
  377. XC                        !MOVE TO ROOM.
  378. X    IF(WALK) WALK=RMDESC(0)
  379. XC                        !DESCRIBE ROOM.
  380. X    RETURN
  381. X    END
  382. XC CXAPPL- CONDITIONAL EXIT PROCESSORS
  383. XC
  384. XC DECLARATIONS
  385. XC
  386. X    INTEGER FUNCTION CXAPPL(RI)
  387. X    IMPLICIT INTEGER (A-Z)
  388. X#include "gamestate.h"
  389. X#include "parser.h"
  390. X#include "puzzle.h"
  391. X#include "rooms.h"
  392. X#include "rindex.h"
  393. X#include "exits.h"
  394. X#include "curxt.h"
  395. X#include "xpars.h"
  396. X#include "xsrch.h"
  397. X#include "objects.h"
  398. X#include "oflags.h"
  399. X#include "oindex.h"
  400. X#include "advers.h"
  401. X#include "flags.h"
  402. XC CXAPPL, PAGE 2
  403. XC
  404. X    CXAPPL=0
  405. XC                        !NO RETURN.
  406. X    IF(RI.EQ.0) RETURN
  407. XC                        !IF NO ACTION, DONE.
  408. X    GO TO (1000,2000,3000,4000,5000,6000,7000,
  409. X&        8000,9000,10000,11000,12000,13000,14000),RI
  410. X    CALL BUG(5,RI)
  411. XC
  412. XC C1- COFFIN-CURE
  413. XC
  414. X1000    EGYPTF=OADV(COFFI).NE.WINNER
  415. XC                        !T IF NO COFFIN.
  416. X    RETURN
  417. XC
  418. XC C2- CAROUSEL EXIT
  419. XC C5- CAROUSEL OUT
  420. XC
  421. X2000    IF(CAROFF) RETURN
  422. XC                        !IF FLIPPED, NOTHING.
  423. X2500    CALL RSPEAK(121)
  424. XC                        !SPIN THE COMPASS.
  425. X5000    I=XELNT(XCOND)*RND(8)
  426. XC                        !CHOOSE RANDOM EXIT.
  427. X    XROOM1=and(TRAVEL(REXIT(HERE)+I),XRMASK)
  428. X    CXAPPL=XROOM1
  429. XC                        !RETURN EXIT.
  430. X    RETURN
  431. XC
  432. XC C3- CHIMNEY FUNCTION
  433. XC
  434. X3000    LITLDF=.FALSE.
  435. XC                        !ASSUME HEAVY LOAD.
  436. X    J=0
  437. X    DO 3100 I=1,OLNT
  438. XC                        !COUNT OBJECTS.
  439. X      IF(OADV(I).EQ.WINNER) J=J+1
  440. X3100    CONTINUE
  441. XC
  442. X    IF(J.GT.2) RETURN
  443. XC                        !CARRYING TOO MUCH?
  444. X    XSTRNG=446
  445. XC                        !ASSUME NO LAMP.
  446. X    IF(OADV(LAMP).NE.WINNER) RETURN
  447. XC                        !NO LAMP?
  448. X    LITLDF=.TRUE.
  449. XC                        !HE CAN DO IT.
  450. X    IF(and(OFLAG2(DOOR),OPENBT).EQ.0)
  451. X&        OFLAG2(DOOR)=and(OFLAG2(DOOR), not(TCHBT))
  452. X    RETURN
  453. XC
  454. XC C4-    FROBOZZ FLAG (MAGNET ROOM, FAKE EXIT)
  455. XC C6-    FROBOZZ FLAG (MAGNET ROOM, REAL EXIT)
  456. XC
  457. X4000    IF(CAROFF) GO TO 2500
  458. XC                        !IF FLIPPED, GO SPIN.
  459. X    FROBZF=.FALSE.
  460. XC                        !OTHERWISE, NOT AN EXIT.
  461. X    RETURN
  462. XC
  463. X6000    IF(CAROFF) GO TO 2500
  464. XC                        !IF FLIPPED, GO SPIN.
  465. X    FROBZF=.TRUE.
  466. XC                        !OTHERWISE, AN EXIT.
  467. X    RETURN
  468. XC
  469. XC C7-    FROBOZZ FLAG (BANK ALARM)
  470. XC
  471. X7000    FROBZF=and((OROOM(BILLS).NE.0),(OROOM(PORTR).NE.0))
  472. X    RETURN
  473. XC CXAPPL, PAGE 3
  474. XC
  475. XC C8-    FROBOZZ FLAG (MRGO)
  476. XC
  477. X8000    FROBZF=.FALSE.
  478. XC                        !ASSUME CANT MOVE.
  479. X    IF(MLOC.NE.XROOM1) GO TO 8100
  480. XC                        !MIRROR IN WAY?
  481. X    IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
  482. X    IF(MOD(MDIR,180).NE.0) GO TO 8300
  483. XC                        !MIRROR MUST BE N-S.
  484. X    XROOM1=((XROOM1-MRA)*2)+MRAE
  485. XC                        !CALC EAST ROOM.
  486. X    IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1
  487. XC                        !IF SW/NW, CALC WEST.
  488. X8100    CXAPPL=XROOM1
  489. X    RETURN
  490. XC
  491. X8200    XSTRNG=814
  492. XC                        !ASSUME STRUC BLOCKS.
  493. X    IF(MOD(MDIR,180).EQ.0) RETURN
  494. XC                        !IF MIRROR N-S, DONE.
  495. X8300    LDIR=MDIR
  496. XC                        !SEE WHICH MIRROR.
  497. X    IF(PRSO.EQ.XSOUTH) LDIR=180
  498. X    XSTRNG=815
  499. XC                        !MIRROR BLOCKS.
  500. X    IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
  501. X&      ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816
  502. X    RETURN
  503. XC
  504. XC C9-    FROBOZZ FLAG (MIRIN)
  505. XC
  506. X9000    IF(MRHERE(HERE).NE.1) GO TO 9100
  507. XC                        !MIRROR 1 HERE?
  508. X    IF(MR1F) XSTRNG=805
  509. XC                        !SEE IF BROKEN.
  510. X    FROBZF=MROPNF
  511. XC                        !ENTER IF OPEN.
  512. X    RETURN
  513. XC
  514. X9100    FROBZF=.FALSE.
  515. XC                        !NOT HERE,
  516. X    XSTRNG=817
  517. XC                        !LOSE.
  518. X    RETURN
  519. XC CXAPPL, PAGE 4
  520. XC
  521. XC C10-    FROBOZZ FLAG (MIRROR EXIT)
  522. XC
  523. X10000    FROBZF=.FALSE.
  524. XC                        !ASSUME CANT.
  525. X    LDIR=((PRSO-XNORTH)/XNORTH)*45
  526. XC                        !XLATE DIR TO DEGREES.
  527. X    IF(.NOT.MROPNF .OR.
  528. X&        ((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
  529. X&        GO TO 10200
  530. X    XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180)
  531. XC                        !ASSUME E-W EXIT.
  532. X    IF(MOD(MDIR,180).EQ.0) GO TO 10100
  533. XC                        !IF N-S, OK.
  534. X    XROOM1=MLOC+1
  535. XC                        !ASSUME N EXIT.
  536. X    IF(MDIR.GT.180) XROOM1=MLOC-1
  537. XC                        !IF SOUTH.
  538. X10100    CXAPPL=XROOM1
  539. X    RETURN
  540. XC
  541. X10200    IF(.NOT.WDOPNF .OR.
  542. X&        ((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
  543. X&        RETURN
  544. X    XROOM1=MLOC+1
  545. XC                        !ASSUME N.
  546. X    IF(MDIR.EQ.0) XROOM1=MLOC-1
  547. XC                        !IF S.
  548. X    CALL RSPEAK(818)
  549. XC                        !CLOSE DOOR.
  550. X    WDOPNF=.FALSE.
  551. X    CXAPPL=XROOM1
  552. X    RETURN
  553. XC
  554. XC C11-    MAYBE DOOR.  NORMAL MESSAGE IS THAT DOOR IS CLOSED.
  555. XC    BUT IF LCELL.NE.4, DOOR ISNT THERE.
  556. XC
  557. X11000    IF(LCELL.NE.4) XSTRNG=678
  558. XC                        !SET UP MSG.
  559. X    RETURN
  560. XC
  561. XC C12-    FROBZF (PUZZLE ROOM MAIN ENTRANCE)
  562. XC
  563. X12000    FROBZF=.TRUE.
  564. XC                        !ALWAYS ENTER.
  565. X    CPHERE=10
  566. XC                        !SET SUBSTATE.
  567. X    RETURN
  568. XC
  569. XC C13-    CPOUTF (PUZZLE ROOM SIZE ENTRANCE)
  570. XC
  571. X13000    CPHERE=52
  572. XC                        !SET SUBSTATE.
  573. X    RETURN
  574. XC CXAPPL, PAGE 5
  575. XC
  576. XC C14-    FROBZF (PUZZLE ROOM TRANSITIONS)
  577. XC
  578. X14000    FROBZF=.FALSE.
  579. XC                        !ASSSUME LOSE.
  580. X    IF(PRSO.NE.XUP) GO TO 14100
  581. XC                        !UP?
  582. X    IF(CPHERE.NE.10) RETURN
  583. XC                        !AT EXIT?
  584. X    XSTRNG=881
  585. XC                        !ASSUME NO LADDER.
  586. X    IF(CPVEC(CPHERE+1).NE.-2) RETURN
  587. XC                        !LADDER HERE?
  588. X    CALL RSPEAK(882)
  589. XC                        !YOU WIN.
  590. X    FROBZF=.TRUE.
  591. XC                        !LET HIM OUT.
  592. X    RETURN
  593. XC
  594. X14100    IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
  595. X&        GO TO 14200
  596. X    FROBZF=.TRUE.
  597. XC                        !YES, LET HIM OUT.
  598. X    RETURN
  599. XC
  600. X14200    DO 14300 I=1,16,2
  601. XC                        !LOCATE EXIT.
  602. X      IF(PRSO.EQ.CPDR(I)) GO TO 14400
  603. X14300    CONTINUE
  604. X    RETURN
  605. XC                        !NO SUCH EXIT.
  606. XC
  607. X14400    J=CPDR(I+1)
  608. XC                        !GET DIRECTIONAL OFFSET.
  609. X    NXT=CPHERE+J
  610. XC                        !GET NEXT STATE.
  611. X    K=8
  612. XC                        !GET ORTHOGONAL DIR.
  613. X    IF(J.LT.0) K=-8
  614. X    IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
  615. X&       ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
  616. X&        (CPVEC(NXT).EQ.0)) GO TO 14500
  617. X    RETURN
  618. XC
  619. X14500    CALL CPGOTO(NXT)
  620. XC                        !MOVE TO STATE.
  621. X    XROOM1=CPUZZ
  622. XC                        !STAY IN ROOM.
  623. X    CXAPPL=XROOM1
  624. X    RETURN
  625. XC
  626. X    END
  627. END_OF_dverb2.F
  628. if test 10970 -ne `wc -c <dverb2.F`; then
  629.     echo shar: \"dverb2.F\" unpacked with wrong size!
  630. fi
  631. # end of overwriting check
  632. fi
  633. if test -f gdt.F -a "${1}" != "-c" ; then 
  634.   echo shar: Will not over-write existing file \"gdt.F\"
  635. else
  636. echo shar: Extracting \"gdt.F\" \(11509 characters\)
  637. sed "s/^X//" >gdt.F <<'END_OF_gdt.F'
  638. XC GDT- GAME DEBUGGING TOOL
  639. XC
  640. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  641. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  642. XC WRITTEN BY R. M. SUPNIK
  643. XC
  644. XC DECLARATIONS
  645. XC
  646. X    SUBROUTINE GDT
  647. X    IMPLICIT INTEGER (A-Z)
  648. X#ifdef PDP
  649. XC
  650. XC    no debugging tool available in pdp version
  651. XC
  652. X    call nogdt
  653. X    return
  654. X#else
  655. X    CHARACTER*2 DBGCMD(38),CMD
  656. X    INTEGER ARGTYP(38)
  657. X    LOGICAL VALID1,VALID2,VALID3
  658. X    character*2 ldbgcmd(38)
  659. X#include "parser.h"
  660. X#include "gamestate.h"
  661. X#include "state.h"
  662. X#include "screen.h"
  663. X#include "puzzle.h"
  664. XC
  665. XC MISCELLANEOUS VARIABLES
  666. XC
  667. X    COMMON /STAR/ MBASE,STRBIT
  668. X#include "io.h"
  669. X#include "mindex.h"
  670. X#include "debug.h"
  671. X#include "rooms.h"
  672. X#include "rindex.h"
  673. X#include "exits.h"
  674. X#include "objects.h"
  675. X#include "oindex.h"
  676. X#include "clock.h"
  677. X#include "villians.h"
  678. X#include "advers.h"
  679. X#include "flags.h"
  680. XC
  681. XC FUNCTIONS AND DATA
  682. XC
  683. X    VALID1(A1,L1)=(A1.GT.0).AND.(A1.LE.L1)
  684. X    VALID2(A1,A2,L1)=VALID1(A1,L1).AND.VALID1(A2,L1).AND.
  685. X&        (A1.LE.A2)
  686. X    VALID3(A1,L1,A2,L2)=VALID1(A1,L1).AND.VALID1(A2,L2)
  687. X    DATA CMDMAX/38/
  688. X    DATA DBGCMD/'DR','DO','DA','DC','DX','DH','DL','DV','DF','DS',
  689. X&        'AF','HE','NR','NT','NC','ND','RR','RT','RC','RD',
  690. X&        'TK','EX','AR','AO','AA','AC','AX','AV','D2','DN',
  691. X&        'AN','DM','DT','AH','DP','PD','DZ','AZ'/
  692. X    DATA ldbgcmd/'dr','do','da','dc','dx','dh','dl','dv','df','ds',
  693. X&        'af','he','nr','nt','nc','nd','rr','rt','rc','rd',
  694. X&        'tk','ex','ar','ao','aa','ac','ax','av','d2','dn',
  695. X&        'an','dm','dt','ah','dp','pd','dz','az'/
  696. X    DATA ARGTYP/  2 ,  2 ,  2 ,  2 ,  2 ,  0 ,  0 ,  2 ,  2 ,  0 ,
  697. X&          1 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
  698. X&          1 ,  0 ,  3 ,  3 ,  3 ,  3 ,  1 ,  3 ,  2 ,  2 ,
  699. X&          1 ,  2 ,  1 ,  0 ,  0 ,  0 ,  0 ,  1 /
  700. XC GDT, PAGE 2
  701. XC
  702. XC FIRST, VALIDATE THAT THE CALLER IS AN IMPLEMENTER.
  703. XC
  704. X    FMAX=46
  705. XC                        !SET ARRAY LIMITS.
  706. X    SMAX=22
  707. XC
  708. X    IF(GDTFLG.NE.0) GO TO 2000
  709. XC                        !IF OK, SKIP.
  710. X    WRITE(OUTCH,100)
  711. XC                        !NOT AN IMPLEMENTER.
  712. X    RETURN
  713. XC                        !BOOT HIM OFF
  714. XC
  715. X100    FORMAT(' You are not an authorized user.')
  716. Xc GDT, PAGE 2A
  717. XC
  718. XC HERE TO GET NEXT COMMAND
  719. XC
  720. X2000    WRITE(OUTCH,200)
  721. XC                        !OUTPUT PROMPT.
  722. X    READ(INPCH,210) CMD
  723. XC                        !GET COMMAND.
  724. X    IF(CMD.EQ.'  ') GO TO 2000
  725. XC                        !IGNORE BLANKS.
  726. X    DO 2100 I=1,CMDMAX
  727. XC                        !LOOK IT UP.
  728. X      IF(CMD.EQ.DBGCMD(I)) GO TO 2300
  729. XC                        !FOUND?
  730. XC      check for lower case command, as well
  731. X      if(cmd .eq. ldbgcmd(i)) go to 2300
  732. X2100    CONTINUE
  733. X2200    WRITE(OUTCH,220)
  734. XC                        !NO, LOSE.
  735. X    GO TO 2000
  736. XC
  737. X200    FORMAT(' GDT>',$)
  738. X210    FORMAT(A2)
  739. X220    FORMAT(' ?')
  740. X230    FORMAT(2I6)
  741. X240    FORMAT(I6)
  742. X225    FORMAT(' Limits:   ',$)
  743. X235    FORMAT(' Entry:    ',$)
  744. X245    FORMAT(' Idx,Ary:  ',$)
  745. Xc
  746. X2300    GO TO (2400,2500,2600,2700),ARGTYP(I)+1
  747. XC                        !BRANCH ON ARG TYPE.
  748. X    GO TO 2200
  749. XC                        !ILLEGAL TYPE.
  750. XC
  751. X2700    WRITE(OUTCH,245)
  752. XC                        !TYPE 3, REQUEST ARRAY COORDS.
  753. X    READ(INPCH,230) J,K
  754. X    GO TO 2400
  755. XC
  756. X2600    WRITE(OUTCH,225)
  757. XC                        !TYPE 2, READ BOUNDS.
  758. X    READ(INPCH,230) J,K
  759. X    IF(K.EQ.0) K=J
  760. X    GO TO 2400
  761. XC
  762. X2500    WRITE(OUTCH,235)
  763. XC                        !TYPE 1, READ ENTRY NO.
  764. X    READ(INPCH,240) J
  765. X2400    GO TO (10000,11000,12000,13000,14000,15000,16000,17000,18000,
  766. X&     19000,20000,21000,22000,23000,24000,25000,26000,27000,28000,
  767. X&     29000,30000,31000,32000,33000,34000,35000,36000,37000,38000,
  768. X&     39000,40000,41000,42000,43000,44000,45000,46000,47000),I
  769. X    GO TO 2200
  770. XC                        !WHAT???
  771. XC GDT, PAGE 3
  772. XC
  773. XC DR-- DISPLAY ROOMS
  774. XC
  775. X10000    IF(.NOT.VALID2(J,K,RLNT)) GO TO 2200
  776. XC                        !ARGS VALID?
  777. X    WRITE(OUTCH,300)
  778. XC                        !COL HDRS.
  779. X    DO 10100 I=J,K
  780. X      WRITE(OUTCH,310) I,(EQR(I,L),L=1,5)
  781. X10100    CONTINUE
  782. X    GO TO 2000
  783. XC
  784. X300    FORMAT(' RM#  DESC1  EXITS ACTION  VALUE  FLAGS')
  785. X310    FORMAT(1X,I3,4(1X,I6),1X,I6)
  786. XC
  787. XC DO-- DISPLAY OBJECTS
  788. XC
  789. X11000    IF(.NOT.VALID2(J,K,OLNT)) GO TO 2200
  790. XC                        !ARGS VALID?
  791. X    WRITE(OUTCH,320)
  792. XC                        !COL HDRS
  793. X    DO 11100 I=J,K
  794. X      WRITE(OUTCH,330) I,(EQO(I,L),L=1,14)
  795. X11100    CONTINUE
  796. X    GO TO 2000
  797. XC
  798. X320    FORMAT(' OB# DESC1 DESC2 DESCO ACT FLAGS1 FLAGS2 FVL TVL
  799. X&      SIZE CAPAC ROOM ADV CON  READ')
  800. X330    FORMAT(1X,I3,3I6,I4,2I7,2I4,2I6,1X,3I4,I6)
  801. XC
  802. XC DA-- DISPLAY ADVENTURERS
  803. XC
  804. X12000    IF(.NOT.VALID2(J,K,ALNT)) GO TO 2200
  805. XC                        !ARGS VALID?
  806. X    WRITE(OUTCH,340)
  807. X    DO 12100 I=J,K
  808. X      WRITE(OUTCH,350) I,(EQA(I,L),L=1,7)
  809. X12100    CONTINUE
  810. X    GO TO 2000
  811. XC
  812. X340    FORMAT(' AD#   ROOM  SCORE  VEHIC OBJECT ACTION  STREN  FLAGS')
  813. X350    FORMAT(1X,I3,6(1X,I6),1X,I6)
  814. XC
  815. XC DC-- DISPLAY CLOCK EVENTS
  816. XC
  817. X13000    IF(.NOT.VALID2(J,K,CLNT)) GO TO 2200
  818. XC                        !ARGS VALID?
  819. X    WRITE(OUTCH,360)
  820. X    DO 13100 I=J,K
  821. X      WRITE(OUTCH,370) I,(EQC(I,L),L=1,2),CFLAG(I)
  822. X13100    CONTINUE
  823. X    GO TO 2000
  824. XC
  825. X360    FORMAT(' CL#   TICK ACTION  FLAG')
  826. X370    FORMAT(1X,I3,1X,I6,1X,I6,5X,L1)
  827. XC
  828. XC DX-- DISPLAY EXITS
  829. XC
  830. X14000    IF(.NOT.VALID2(J,K,XLNT)) GO TO 2200
  831. XC                        !ARGS VALID?
  832. X    WRITE(OUTCH,380)
  833. XC                        !COL HDRS.
  834. X    DO 14100 I=J,K,10
  835. XC                        !TEN PER LINE.
  836. X      L=MIN0(I+9,K)
  837. XC                        !COMPUTE END OF LINE.
  838. X      WRITE(OUTCH,390) I,L,(TRAVEL(L1),L1=I,L)
  839. X14100    CONTINUE
  840. X    GO TO 2000
  841. XC
  842. X380    FORMAT('   RANGE   CONTENTS')
  843. X390    FORMAT(1X,I3,'-',I3,3X,10I7)
  844. XC
  845. XC DH-- DISPLAY HACKS
  846. XC
  847. X15000    WRITE(OUTCH,400) THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  848. X    GO TO 2000
  849. XC
  850. X400    FORMAT(' THFPOS=',I6,', THFFLG=',L2,',THFACT=',L2/
  851. X&    ' SWDACT=',L2,', SWDSTA=',I2)
  852. XC
  853. XC DL-- DISPLAY LENGTHS
  854. XC
  855. X16000    WRITE(OUTCH,410) RLNT,XLNT,OLNT,CLNT,VLNT,ALNT,MLNT,R2LNT,
  856. X&        MBASE,STRBIT
  857. X    GO TO 2000
  858. XC
  859. X410    FORMAT(' R=',I6,', X=',I6,', O=',I6,', C=',I6/
  860. X&    ' V=',I6,', A=',I6,', M=',I6,', R2=',I5/
  861. X&    ' MBASE=',I6,', STRBIT=',I6)
  862. XC
  863. XC DV-- DISPLAY VILLAINS
  864. XC
  865. X17000    IF(.NOT.VALID2(J,K,VLNT)) GO TO 2200
  866. XC                        !ARGS VALID?
  867. X    WRITE(OUTCH,420)
  868. XC                        !COL HDRS
  869. X    DO 17100 I=J,K
  870. X      WRITE(OUTCH,430) I,(EQV(I,L),L=1,5)
  871. X17100    CONTINUE
  872. X    GO TO 2000
  873. XC
  874. X420    FORMAT(' VL# OBJECT   PROB   OPPS   BEST  MELEE')
  875. X430    FORMAT(1X,I3,5(1X,I6))
  876. XC
  877. XC DF-- DISPLAY FLAGS
  878. XC
  879. X18000    IF(.NOT.VALID2(J,K,FMAX)) GO TO 2200
  880. XC                        !ARGS VALID?
  881. X    DO 18100 I=J,K
  882. X      WRITE(OUTCH,440) I,FLAGS(I)
  883. X18100    CONTINUE
  884. X    GO TO 2000
  885. XC
  886. X440    FORMAT(' Flag #',I2,' = ',L1)
  887. XC
  888. XC DS-- DISPLAY STATE
  889. XC
  890. X19000    WRITE(OUTCH,450) PRSA,PRSO,PRSI,PRSWON,PRSCON
  891. X    WRITE(OUTCH,460) WINNER,HERE,TELFLG
  892. X    WRITE(OUTCH,470) MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,LTSHFT,BLOC,
  893. X&        MUNGRM,HS,EGSCOR,EGMXSC
  894. X    WRITE(OUTCH,475) FROMDR,SCOLRM,SCOLAC
  895. X    GO TO 2000
  896. XC
  897. X450    FORMAT(' Parse vector=',3(1X,I6),1X,L6,1X,I6)
  898. X460    FORMAT(' Play vector= ',2(1X,I6),1X,L6)
  899. X470    FORMAT(' State vector=',9(1X,I6)/14X,2(1X,I6))
  900. X475    FORMAT(' Scol vector= ',1X,I6,2(1X,I6))
  901. XC GDT, PAGE 4
  902. XC
  903. XC AF-- ALTER FLAGS
  904. XC
  905. X20000    IF(.NOT.VALID1(J,FMAX)) GO TO 2200
  906. XC                        !ENTRY NO VALID?
  907. X    WRITE(OUTCH,480) FLAGS(J)
  908. XC                        !TYPE OLD, GET NEW.
  909. X    READ(INPCH,490) FLAGS(J)
  910. X    GO TO 2000
  911. XC
  912. X480    FORMAT(' Old=',L2,6X,'New= ',$)
  913. X490    FORMAT(L1)
  914. XC
  915. XC 21000-- HELP
  916. XC
  917. X21000    WRITE(OUTCH,900)
  918. X    GO TO 2000
  919. XC
  920. X900    FORMAT(' Valid commands are:'/' AA- Alter ADVS'/
  921. X&    ' AC- Alter CEVENT'/' AF- Alter FINDEX'/' AH- Alter HERE'/
  922. X&    ' AN- Alter switches'/' AO- Alter OBJCTS'/' AR- Alter ROOMS'/
  923. X&    ' AV- Alter VILLS'/' AX- Alter EXITS'/
  924. X&    ' AZ- Alter PUZZLE'/' DA- Display ADVS'/
  925. X&    ' DC- Display CEVENT'/' DF- Display FINDEX'/' DH- Display HACKS'/
  926. X&    ' DL- Display lengths'/' DM- Display RTEXT'/
  927. X&    ' DN- Display switches'/
  928. X&    ' DO- Display OBJCTS'/' DP- Display parser'/
  929. X&    ' DR- Display ROOMS'/' DS- Display state'/' DT- Display text'/
  930. X&    ' DV- Display VILLS'/' DX- Display EXITS'/' DZ- Display PUZZLE'/
  931. X&    ' D2- Display ROOM2'/' EX- Exit'/' HE- Type this message'/
  932. X&    ' NC- No cyclops'/' ND- No deaths'/' NR- No robber'/
  933. X&    ' NT- No troll'/' PD- Program detail'/
  934. X&    ' RC- Restore cyclops'/' RD- Restore deaths'/
  935. X&    ' RR- Restore robber'/' RT- Restore troll'/' TK- Take.')
  936. XC
  937. XC NR-- NO ROBBER
  938. XC
  939. X22000    THFFLG=.FALSE.
  940. XC                        !DISABLE ROBBER.
  941. X    THFACT=.FALSE.
  942. X    CALL NEWSTA(THIEF,0,0,0,0)
  943. XC                        !VANISH THIEF.
  944. X    WRITE(OUTCH,500)
  945. X    GO TO 2000
  946. XC
  947. X500    FORMAT(' No robber.')
  948. XC
  949. XC NT-- NO TROLL
  950. XC
  951. X23000    TROLLF=.TRUE.
  952. X    CALL NEWSTA(TROLL,0,0,0,0)
  953. X    WRITE(OUTCH,510)
  954. X    GO TO 2000
  955. XC
  956. X510    FORMAT(' No troll.')
  957. XC
  958. XC NC-- NO CYCLOPS
  959. XC
  960. X24000    CYCLOF=.TRUE.
  961. X    CALL NEWSTA(CYCLO,0,0,0,0)
  962. X    WRITE(OUTCH,520)
  963. X    GO TO 2000
  964. XC
  965. X520    FORMAT(' No cyclops.')
  966. XC
  967. XC ND-- IMMORTALITY MODE
  968. XC
  969. X25000    DBGFLG=1
  970. X    WRITE(OUTCH,530)
  971. X    GO TO 2000
  972. XC
  973. X530    FORMAT(' No deaths.')
  974. XC
  975. XC RR-- RESTORE ROBBER
  976. XC
  977. X26000    THFACT=.TRUE.
  978. X    WRITE(OUTCH,540)
  979. X    GO TO 2000
  980. XC
  981. X540    FORMAT(' Restored robber.')
  982. XC
  983. XC RT-- RESTORE TROLL
  984. XC
  985. X27000    TROLLF=.FALSE.
  986. X    CALL NEWSTA(TROLL,0,MTROL,0,0)
  987. X    WRITE(OUTCH,550)
  988. X    GO TO 2000
  989. XC
  990. X550    FORMAT(' Restored troll.')
  991. XC
  992. XC RC-- RESTORE CYCLOPS
  993. XC
  994. X28000    CYCLOF=.FALSE.
  995. X    MAGICF=.FALSE.
  996. X    CALL NEWSTA(CYCLO,0,MCYCL,0,0)
  997. X    WRITE(OUTCH,560)
  998. X    GO TO 2000
  999. XC
  1000. X560    FORMAT(' Restored cyclops.')
  1001. XC
  1002. XC RD-- MORTAL MODE
  1003. XC
  1004. X29000    DBGFLG=0
  1005. X    WRITE(OUTCH,570)
  1006. X    GO TO 2000
  1007. XC
  1008. X570    FORMAT(' Restored deaths.')
  1009. XC GDT, PAGE 5
  1010. XC
  1011. XC TK-- TAKE
  1012. XC
  1013. X30000    IF(.NOT.VALID1(J,OLNT)) GO TO 2200
  1014. XC                        !VALID OBJECT?
  1015. X    CALL NEWSTA(J,0,0,0,WINNER)
  1016. XC                        !YES, TAKE OBJECT.
  1017. X    WRITE(OUTCH,580)
  1018. XC                        !TELL.
  1019. X    GO TO 2000
  1020. XC
  1021. X580    FORMAT(' Taken.')
  1022. XC
  1023. XC EX-- GOODBYE
  1024. XC
  1025. X31000    PRSCON=1
  1026. X    RETURN
  1027. XC
  1028. XC AR--    ALTER ROOM ENTRY
  1029. XC
  1030. X32000    IF(.NOT.VALID3(J,RLNT,K,5)) GO TO 2200
  1031. XC                        !INDICES VALID?
  1032. X    WRITE(OUTCH,590) EQR(J,K)
  1033. XC                        !TYPE OLD, GET NEW.
  1034. X    READ(INPCH,600) EQR(J,K)
  1035. X    GO TO 2000
  1036. XC
  1037. X590    FORMAT(' Old= ',I6,6X,'New= ',$)
  1038. X600    FORMAT(I6)
  1039. XC
  1040. XC AO-- ALTER OBJECT ENTRY
  1041. XC
  1042. X33000    IF(.NOT.VALID3(J,OLNT,K,14)) GO TO 2200
  1043. XC                        !INDICES VALID?
  1044. X    WRITE(OUTCH,590) EQO(J,K)
  1045. X    READ(INPCH,600) EQO(J,K)
  1046. X    GO TO 2000
  1047. XC
  1048. XC AA-- ALTER ADVS ENTRY
  1049. XC
  1050. X34000    IF(.NOT.VALID3(J,ALNT,K,7)) GO TO 2200
  1051. XC                        !INDICES VALID?
  1052. X    WRITE(OUTCH,590) EQA(J,K)
  1053. X    READ(INPCH,600) EQA(J,K)
  1054. X    GO TO 2000
  1055. XC
  1056. XC AC-- ALTER CLOCK EVENTS
  1057. XC
  1058. X35000    IF(.NOT.VALID3(J,CLNT,K,3)) GO TO 2200
  1059. XC                        !INDICES VALID?
  1060. X    IF(K.EQ.3) GO TO 35500
  1061. XC                        !FLAGS ENTRY?
  1062. X    WRITE(OUTCH,590) EQC(J,K)
  1063. X    READ(INPCH,600) EQC(J,K)
  1064. X    GO TO 2000
  1065. XC
  1066. X35500    WRITE(OUTCH,480) CFLAG(J)
  1067. X    READ(INPCH,490) CFLAG(J)
  1068. X    GO TO 2000
  1069. XC GDT, PAGE 6
  1070. XC
  1071. XC AX-- ALTER EXITS
  1072. XC
  1073. X36000    IF(.NOT.VALID1(J,XLNT)) GO TO 2200
  1074. XC                        !ENTRY NO VALID?
  1075. X    WRITE(OUTCH,610) TRAVEL(J)
  1076. X    READ(INPCH,620) TRAVEL(J)
  1077. X    GO TO 2000
  1078. XC
  1079. X610    FORMAT(' Old= ',I6,6X,'New= ',$)
  1080. X620    FORMAT(I6)
  1081. XC
  1082. XC AV-- ALTER VILLAINS
  1083. XC
  1084. X37000    IF(.NOT.VALID3(J,VLNT,K,5)) GO TO 2200
  1085. XC                        !INDICES VALID?
  1086. X    WRITE(OUTCH,590) EQV(J,K)
  1087. X    READ(INPCH,600) EQV(J,K)
  1088. X    GO TO 2000
  1089. XC
  1090. XC D2-- DISPLAY ROOM2 LIST
  1091. XC
  1092. X38000    IF(.NOT.VALID2(J,K,R2LNT)) GO TO 2200
  1093. X    DO 38100 I=J,K
  1094. X      WRITE(OUTCH,630) I,RROOM2(I),OROOM2(I)
  1095. X38100    CONTINUE
  1096. X    GO TO 2000
  1097. XC
  1098. X630    FORMAT(' #',I2,'   Room=',I6,'   Obj=',I6)
  1099. XC
  1100. XC DN-- DISPLAY SWITCHES
  1101. XC
  1102. X39000    IF(.NOT.VALID2(J,K,SMAX)) GO TO 2200
  1103. XC                        !VALID?
  1104. X    DO 39100 I=J,K
  1105. X      WRITE(OUTCH,640) I,SWITCH(I)
  1106. X39100    CONTINUE
  1107. X    GO TO 2000
  1108. XC
  1109. X640    FORMAT(' Switch #',I2,' = ',I6)
  1110. XC
  1111. XC AN-- ALTER SWITCHES
  1112. XC
  1113. X40000    IF(.NOT.VALID1(J,SMAX)) GO TO 2200
  1114. XC                        !VALID ENTRY?
  1115. X    WRITE(OUTCH,590) SWITCH(J)
  1116. X    READ(INPCH,600) SWITCH(J)
  1117. X    GO TO 2000
  1118. XC
  1119. XC DM-- DISPLAY MESSAGES
  1120. XC
  1121. X41000    IF(.NOT.VALID2(J,K,MLNT)) GO TO 2200
  1122. XC                        !VALID LIMITS?
  1123. X    WRITE(OUTCH,380)
  1124. X    DO 41100 I=J,K,10
  1125. X      L=MIN0(I+9,K)
  1126. X      WRITE(OUTCH,650) I,L,(RTEXT(L1),L1=I,L)
  1127. X41100    CONTINUE
  1128. X    GO TO 2000
  1129. XC
  1130. X650    FORMAT(1X,I3,'-',I3,3X,10(1X,I6))
  1131. XC
  1132. XC DT-- DISPLAY TEXT
  1133. XC
  1134. X42000    CALL RSPEAK(J)
  1135. X    GO TO 2000
  1136. XC
  1137. XC AH--    ALTER HERE
  1138. XC
  1139. X43000    WRITE(OUTCH,590) HERE
  1140. X    READ(INPCH,600) HERE
  1141. X    EQA(1,1)=HERE
  1142. X    GO TO 2000
  1143. XC
  1144. XC DP--    DISPLAY PARSER STATE
  1145. XC
  1146. X44000    WRITE(OUTCH,660) ORP,LASTIT,PVEC,SYN
  1147. X    GO TO 2000
  1148. XC
  1149. X660    FORMAT(' ORPHS= ',I7,I7,4I7/
  1150. X&    ' PV=    ',I7,4I7/' SYN=   ',6I7/15X,5I7)
  1151. XC
  1152. XC PD--    PROGRAM DETAIL DEBUG
  1153. XC
  1154. X45000    WRITE(OUTCH,610) PRSFLG
  1155. XC                        !TYPE OLD, GET NEW.
  1156. X    READ(INPCH,620) PRSFLG
  1157. X    GO TO 2000
  1158. XC
  1159. XC DZ--    DISPLAY PUZZLE ROOM
  1160. XC
  1161. X46000    DO 46100 I=1,64,8
  1162. XC                        !DISPLAY PUZZLE
  1163. X      WRITE(OUTCH,670) (CPVEC(J),J=I,I+7)
  1164. X46100    CONTINUE
  1165. X    GO TO 2000
  1166. XC
  1167. X670    FORMAT(2X,8I3)
  1168. XC
  1169. XC AZ--    ALTER PUZZLE ROOM
  1170. XC
  1171. X47000    IF(.NOT.VALID1(J,64)) GO TO 2200
  1172. XC                        !VALID ENTRY?
  1173. X    WRITE(OUTCH,590) CPVEC(J)
  1174. XC                        !OUTPUT OLD,
  1175. X    READ(INPCH,600) CPVEC(J)
  1176. X    GO TO 2000
  1177. XC
  1178. X#endif PDP
  1179. X    END
  1180. END_OF_gdt.F
  1181. if test 11509 -ne `wc -c <gdt.F`; then
  1182.     echo shar: \"gdt.F\" unpacked with wrong size!
  1183. fi
  1184. # end of overwriting check
  1185. fi
  1186. if test -f lex.c -a "${1}" != "-c" ; then 
  1187.   echo shar: Will not over-write existing file \"lex.c\"
  1188. else
  1189. echo shar: Extracting \"lex.c\" \(1532 characters\)
  1190. sed "s/^X//" >lex.c <<'END_OF_lex.c'
  1191. X#define FALSE    0
  1192. X#define TRUE    1
  1193. X
  1194. Xlex_(inbuf, inlnt, outbuf, op, vbflag, lprscon)
  1195. X    char inbuf[78];
  1196. X    int outbuf[40], *inlnt, *op, *vbflag;
  1197. X    int *lprscon;    /* added */
  1198. X{
  1199. X    /*
  1200. X     * lex - lexical analyzer, converted from fortran
  1201. X     *
  1202. X     * input: one line of ascii characters
  1203. X     * output: tokenized input, packed in radix-50 format
  1204. X     */
  1205. X
  1206. X    char    j;
  1207. X    int    cp, i, k, prsptr;
  1208. X    static int    num601 = {601};
  1209. X
  1210. X    for (i=0; i<40; i++)
  1211. X        outbuf[i] = 0;
  1212. X    *op = -1;
  1213. X    prsptr = *lprscon - 1;
  1214. X    /* printf("lex: inbuf=%s, inlnt=%d\n", inbuf, *inlnt); */
  1215. X
  1216. Xtoknlp:
  1217. X    *op += 2;
  1218. X    cp = 0;
  1219. X    while ((*lprscon)++ <= *inlnt) {
  1220. X        j = inbuf[prsptr++];
  1221. X        /* printf("lex: chr=%c\n", j); */
  1222. X        if ((j == '.') || (j == ','))
  1223. X            break;
  1224. X        else if (j == ' ')
  1225. X            if (cp)        /* if (cp != 0) */
  1226. X                goto toknlp;
  1227. X            else
  1228. X                continue;   /* first token */
  1229. X        else if ((j >= 'A') && (j <= 'Z'))
  1230. X            j -= '@';
  1231. X        else if (((j >= '1') && (j <= '9')) || (j == '-'))
  1232. X            j -= 0x0c;    /* formfeed */
  1233. X        else {
  1234. X            if (*vbflag)
  1235. X                rspeak_(&num601);
  1236. X            return(FALSE);
  1237. X        }
  1238. X
  1239. X        if (cp >= 6)
  1240. X            /*
  1241. X             * ignore remainder of any token > 6 chars
  1242. X             */
  1243. X            continue;
  1244. X        /*
  1245. X         * pack three chars per word in radix-50 format
  1246. X         */
  1247. X        k = *op + (cp/3) - 1;
  1248. X        /* printf("*op=%d, cp=%d, k=%d\n", *op, cp, k); */
  1249. X        switch (cp%3) {
  1250. X            case 0:
  1251. X                outbuf[k] += j * 1560;
  1252. X            case 1:
  1253. X                outbuf[k] += j * 39;
  1254. X            case 2:
  1255. X                outbuf[k] += j;
  1256. X        }
  1257. X        cp++;
  1258. X    }
  1259. X    if (*lprscon > *inlnt)
  1260. X        *lprscon = 1;
  1261. X    if (!cp)    /* if (cp == 0) */
  1262. X        if (*op == 1)
  1263. X            return(FALSE);   /* no valid tokens */
  1264. X        else {
  1265. X            *op -= 2;
  1266. X            return(TRUE);
  1267. X        };
  1268. X}
  1269. END_OF_lex.c
  1270. if test 1532 -ne `wc -c <lex.c`; then
  1271.     echo shar: \"lex.c\" unpacked with wrong size!
  1272. fi
  1273. # end of overwriting check
  1274. fi
  1275. if test -f nobjs.F -a "${1}" != "-c" ; then 
  1276.   echo shar: Will not over-write existing file \"nobjs.F\"
  1277. else
  1278. echo shar: Extracting \"nobjs.F\" \(13027 characters\)
  1279. sed "s/^X//" >nobjs.F <<'END_OF_nobjs.F'
  1280. XC NOBJS-    NEW OBJECTS PROCESSOR
  1281. XC    OBJECTS IN THIS MODULE CANNOT CALL RMINFO, JIGSUP,
  1282. XC    MAJOR VERBS, OR OTHER NON-RESIDENT SUBROUTINES
  1283. XC
  1284. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  1285. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  1286. XC WRITTEN BY R. M. SUPNIK
  1287. XC
  1288. XC DECLARATIONS
  1289. XC
  1290. X    LOGICAL FUNCTION NOBJS(RI,ARG)
  1291. X    IMPLICIT INTEGER (A-Z)
  1292. X    LOGICAL QOPEN,MOVETO,F
  1293. X    LOGICAL QHERE,OPNCLS,MIRPAN
  1294. X#include "parser.h"
  1295. X#include "gamestate.h"
  1296. X#include "state.h"
  1297. X#include "screen.h"
  1298. X#include "puzzle.h"
  1299. XC
  1300. XC MISCELLANEOUS VARIABLES
  1301. XC
  1302. X    COMMON /HYPER/ HFACTR
  1303. X#include "rooms.h"
  1304. X#include "rflag.h"
  1305. X#include "rindex.h"
  1306. X#include "objects.h"
  1307. X#include "oflags.h"
  1308. X#include "oindex.h"
  1309. X#include "clock.h"
  1310. X
  1311. X#include "villians.h"
  1312. X#include "advers.h"
  1313. X#include "verbs.h"
  1314. X#include "flags.h"
  1315. XC
  1316. XC FUNCTIONS AND DATA
  1317. XC
  1318. X    QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
  1319. XC NOBJS, PAGE 2
  1320. XC
  1321. X    IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
  1322. X    IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
  1323. X    AV=AVEHIC(WINNER)
  1324. X    NOBJS=.TRUE.
  1325. XC
  1326. X    GO TO (1000,2000,3000,4000,5000,6000,7000,8000,9000,
  1327. X&     10000,11000,12000,13000,14000,15000,16000,17000,
  1328. X&     18000,19000,20000,21000),
  1329. X&        (RI-31)
  1330. X    CALL BUG(6,RI)
  1331. XC
  1332. XC RETURN HERE TO DECLARE FALSE RESULT
  1333. XC
  1334. X10    NOBJS=.FALSE.
  1335. X    RETURN
  1336. XC
  1337. XC O32--    BILLS
  1338. XC
  1339. X1000    IF(PRSA.NE.EATW) GO TO 1100
  1340. XC                        !EAT?
  1341. X    CALL RSPEAK(639)
  1342. XC                        !JOKE.
  1343. X    RETURN
  1344. XC
  1345. X1100    IF(PRSA.EQ.BURNW) CALL RSPEAK(640)
  1346. XC                        !BURN?  JOKE.
  1347. X    GO TO 10
  1348. XC                        !LET IT BE HANDLED.
  1349. XC NOBJS, PAGE 3
  1350. XC
  1351. XC O33--    SCREEN OF LIGHT
  1352. XC
  1353. X2000    TARGET=SCOL
  1354. XC                        !TARGET IS SCOL.
  1355. X2100    IF(PRSO.NE.TARGET) GO TO 2400
  1356. XC                        !PRSO EQ TARGET?
  1357. X    IF((PRSA.NE.PUSHW).AND.(PRSA.NE.MOVEW).AND.
  1358. X&        (PRSA.NE.TAKEW).AND.(PRSA.NE.RUBW)) GO TO 2200
  1359. X    CALL RSPEAK(673)
  1360. XC                        !HAND PASSES THRU.
  1361. X    RETURN
  1362. XC
  1363. X2200    IF((PRSA.NE.KILLW).AND.(PRSA.NE.ATTACW).AND.
  1364. X&        (PRSA.NE.MUNGW)) GO TO 2400
  1365. X    CALL RSPSUB(674,ODI2)
  1366. XC                        !PASSES THRU.
  1367. X    RETURN
  1368. XC
  1369. X2400    IF((PRSA.NE.THROWW).OR.(PRSI.NE.TARGET)) GO TO 10
  1370. X    IF(HERE.EQ.BKBOX) GO TO 2600
  1371. XC                        !THRU SCOL?
  1372. X    CALL NEWSTA(PRSO,0,BKBOX,0,0)
  1373. XC                        !NO, THRU WALL.
  1374. X    CALL RSPSUB(675,ODO2)
  1375. XC                        !ENDS UP IN BOX ROOM.
  1376. X    CTICK(CEVSCL)=0
  1377. XC                        !CANCEL ALARM.
  1378. X    SCOLRM=0
  1379. XC                        !RESET SCOL ROOM.
  1380. X    RETURN
  1381. XC
  1382. X2600    IF(SCOLRM.EQ.0) GO TO 2900
  1383. XC                        !TRIED TO GO THRU?
  1384. X    CALL NEWSTA(PRSO,0,SCOLRM,0,0)
  1385. XC                        !SUCCESS.
  1386. X    CALL RSPSUB(676,ODO2)
  1387. XC                        !ENDS UP SOMEWHERE.
  1388. X    CTICK(CEVSCL)=0
  1389. XC                        !CANCEL ALARM.
  1390. X    SCOLRM=0
  1391. XC                        !RESET SCOL ROOM.
  1392. X    RETURN
  1393. XC
  1394. X2900    CALL RSPEAK(213)
  1395. XC                        !CANT DO IT.
  1396. X    RETURN
  1397. XC NOBJS, PAGE 4
  1398. XC
  1399. XC O34--    GNOME OF ZURICH
  1400. XC
  1401. X3000    IF((PRSA.NE.GIVEW).AND.(PRSA.NE.THROWW)) GO TO 3200
  1402. X    IF(OTVAL(PRSO).NE.0) GO TO 3100
  1403. XC                        !THROW A TREASURE?
  1404. X    CALL NEWSTA(PRSO,641,0,0,0)
  1405. XC                        !NO, GO POP.
  1406. X    RETURN
  1407. XC
  1408. X3100    CALL NEWSTA(PRSO,0,0,0,0)
  1409. XC                        !YES, BYE BYE TREASURE.
  1410. X    CALL RSPSUB(642,ODO2)
  1411. X    CALL NEWSTA(ZGNOM,0,0,0,0)
  1412. XC                        !BYE BYE GNOME.
  1413. X    CTICK(CEVZGO)=0
  1414. XC                        !CANCEL EXIT.
  1415. X    F=MOVETO(BKENT,WINNER)
  1416. XC                        !NOW IN BANK ENTRANCE.
  1417. X    RETURN
  1418. XC
  1419. X3200    IF((PRSA.NE.ATTACW).AND.(PRSA.NE.KILLW).AND.
  1420. X&        (PRSA.NE.MUNGW)) GO TO 3300
  1421. X    CALL NEWSTA(ZGNOM,643,0,0,0)
  1422. XC                        !VANISH GNOME.
  1423. X    CTICK(CEVZGO)=0
  1424. XC                        !CANCEL EXIT.
  1425. X    RETURN
  1426. XC
  1427. X3300    CALL RSPEAK(644)
  1428. XC                        !GNOME IS IMPATIENT.
  1429. X    RETURN
  1430. XC
  1431. XC O35--    EGG
  1432. XC
  1433. X4000    IF((PRSA.NE.OPENW).OR.(PRSO.NE.EGG)) GO TO 4500
  1434. X    IF(.NOT.QOPEN(EGG)) GO TO 4100
  1435. XC                        !OPEN ALREADY?
  1436. X    CALL RSPEAK(649)
  1437. XC                        !YES.
  1438. X    RETURN
  1439. XC
  1440. X4100    IF(PRSI.NE.0) GO TO 4200
  1441. XC                        !WITH SOMETHING?
  1442. X    CALL RSPEAK(650)
  1443. XC                        !NO, CANT.
  1444. X    RETURN
  1445. XC
  1446. X4200    IF(PRSI.NE.HANDS) GO TO 4300
  1447. XC                        !WITH HANDS?
  1448. X    CALL RSPEAK(651)
  1449. XC                        !NOT RECOMMENDED.
  1450. X    RETURN
  1451. XC
  1452. X4300    I=652
  1453. XC                        !MUNG MESSAGE.
  1454. X    IF((and(OFLAG1(PRSI),TOOLBT).NE.0).OR.
  1455. X&        (and(OFLAG2(PRSI),WEAPBT).NE.0)) GO TO 4600
  1456. X    I=653
  1457. XC                        !NOVELTY 1.
  1458. X    IF(and(OFLAG2(PRSO),FITEBT).NE.0) I=654
  1459. X    OFLAG2(PRSO)=or(OFLAG2(PRSO),FITEBT)
  1460. X    CALL RSPSUB(I,ODI2)
  1461. X    RETURN
  1462. XC
  1463. X4500    IF((PRSA.NE.OPENW).AND.(PRSA.NE.MUNGW)) GO TO 4800
  1464. X    I=655
  1465. XC                        !YOU BLEW IT.
  1466. X4600    CALL NEWSTA(BEGG,I,OROOM(EGG),OCAN(EGG),OADV(EGG))
  1467. X    CALL NEWSTA(EGG,0,0,0,0)
  1468. XC                        !VANISH EGG.
  1469. X    OTVAL(BEGG)=2
  1470. XC                        !BAD EGG HAS VALUE.
  1471. X    IF(OCAN(CANAR).NE.EGG) GO TO 4700
  1472. XC                        !WAS CANARY INSIDE?
  1473. X    CALL RSPEAK(ODESCO(BCANA))
  1474. XC                        !YES, DESCRIBE RESULT.
  1475. X    OTVAL(BCANA)=1
  1476. X    RETURN
  1477. XC
  1478. X4700    CALL NEWSTA(BCANA,0,0,0,0)
  1479. XC                        !NO, VANISH IT.
  1480. X    RETURN
  1481. XC
  1482. X4800    IF((PRSA.NE.DROPW).OR.(HERE.NE.MTREE)) GO TO 10
  1483. X    CALL NEWSTA(BEGG,658,FORE3,0,0)
  1484. XC                        !DROPPED EGG.
  1485. X    CALL NEWSTA(EGG,0,0,0,0)
  1486. X    OTVAL(BEGG)=2
  1487. X    IF(OCAN(CANAR).NE.EGG) GO TO 4700
  1488. X    OTVAL(BCANA)=1
  1489. XC                        !BAD CANARY.
  1490. X    RETURN
  1491. XC NOBJS, PAGE 5
  1492. XC
  1493. XC O36--    CANARIES, GOOD AND BAD
  1494. XC
  1495. X5000    IF(PRSA.NE.WINDW) GO TO 10
  1496. XC                        !WIND EM UP?
  1497. X    IF(PRSO.EQ.CANAR) GO TO 5100
  1498. XC                        !RIGHT ONE?
  1499. X    CALL RSPEAK(645)
  1500. XC                        !NO, BAD NEWS.
  1501. X    RETURN
  1502. XC
  1503. X5100    IF(.NOT.SINGSF.AND.((HERE.EQ.MTREE).OR.
  1504. X&        ((HERE.GE.FORE1).AND.(HERE.LT.CLEAR))))
  1505. X&        GO TO 5200
  1506. X    CALL RSPEAK(646)
  1507. XC                        !NO, MEDIOCRE NEWS.
  1508. X    RETURN
  1509. XC
  1510. X5200    SINGSF=.TRUE.
  1511. XC                        !SANG SONG.
  1512. X    I=HERE
  1513. X    IF(I.EQ.MTREE) I=FORE3
  1514. XC                        !PLACE BAUBLE.
  1515. X    CALL NEWSTA(BAUBL,647,I,0,0)
  1516. X    RETURN
  1517. XC
  1518. XC O37--    WHITE CLIFFS
  1519. XC
  1520. X6000    IF((PRSA.NE.CLMBW).AND.(PRSA.NE.CLMBUW).AND.
  1521. X&        (PRSA.NE.CLMBDW)) GO TO 10
  1522. X    CALL RSPEAK(648)
  1523. XC                        !OH YEAH?
  1524. X    RETURN
  1525. XC
  1526. XC O38--    WALL
  1527. XC
  1528. X7000    IF((IABS(HERE-MLOC).NE.1).OR.(MRHERE(HERE).NE.0).OR.
  1529. X&        (PRSA.NE.PUSHW)) GO TO 7100
  1530. X    CALL RSPEAK(860)
  1531. XC                        !PUSHED MIRROR WALL.
  1532. X    RETURN
  1533. XC
  1534. X7100    IF(and(RFLAG(HERE),RNWALL).EQ.0) GO TO 10
  1535. X    CALL RSPEAK(662)
  1536. XC                        !NO WALL.
  1537. X    RETURN
  1538. XC NOBJS, PAGE 6
  1539. XC
  1540. XC O39--    SONG BIRD GLOBAL
  1541. XC
  1542. X8000    IF(PRSA.NE.FINDW) GO TO 8100
  1543. XC                        !FIND?
  1544. X    CALL RSPEAK(666)
  1545. X    RETURN
  1546. XC
  1547. X8100    IF(PRSA.NE.EXAMIW) GO TO 10
  1548. XC                        !EXAMINE?
  1549. X    CALL RSPEAK(667)
  1550. X    RETURN
  1551. XC
  1552. XC O40--    PUZZLE/SCOL WALLS
  1553. XC
  1554. X9000    IF(HERE.NE.CPUZZ) GO TO 9500
  1555. XC                        !PUZZLE WALLS?
  1556. X    IF(PRSA.NE.PUSHW) GO TO 10
  1557. XC                        !PUSH?
  1558. X    DO 9100 I=1,8,2
  1559. XC                        !LOCATE WALL.
  1560. X      IF(PRSO.EQ.CPWL(I)) GO TO 9200
  1561. X9100    CONTINUE
  1562. X    CALL BUG(80,PRSO)
  1563. XC                        !WHAT?
  1564. XC
  1565. X9200    J=CPWL(I+1)
  1566. XC                        !GET DIRECTIONAL OFFSET.
  1567. X    NXT=CPHERE+J
  1568. XC                        !GET NEXT STATE.
  1569. X    WL=CPVEC(NXT)
  1570. XC                        !GET C(NEXT STATE).
  1571. X    GO TO (9300,9300,9300,9250,9350),(WL+4)
  1572. XC                        !PROCESS.
  1573. XC
  1574. X9250    CALL RSPEAK(876)
  1575. XC                        !CLEAR CORRIDOR.
  1576. X    RETURN
  1577. XC
  1578. X9300    IF(CPVEC(NXT+J).EQ.0) GO TO 9400
  1579. XC                        !MOVABLE, ROOM TO MOVE?
  1580. X9350    CALL RSPEAK(877)
  1581. XC                        !IMMOVABLE, NO ROOM.
  1582. X    RETURN
  1583. XC
  1584. X9400    I=878
  1585. XC                        !ASSUME FIRST PUSH.
  1586. X    IF(CPUSHF) I=879
  1587. XC                        !NOT?
  1588. X    CPUSHF=.TRUE.
  1589. X    CPVEC(NXT+J)=WL
  1590. XC                        !MOVE WALL.
  1591. X    CPVEC(NXT)=0
  1592. XC                        !VACATE NEXT STATE.
  1593. X    CALL CPGOTO(NXT)
  1594. XC                        !ONWARD.
  1595. X    CALL CPINFO(I,NXT)
  1596. XC                        !DESCRIBE.
  1597. X    CALL PRINCR(.TRUE.,HERE)
  1598. XC                        !PRINT ROOMS CONTENTS.
  1599. X    RFLAG(HERE)=or(RFLAG(HERE),RSEEN)
  1600. X    RETURN
  1601. XC
  1602. X9500    IF(HERE.NE.SCOLAC) GO TO 9700
  1603. XC                        !IN SCOL ACTIVE ROOM?
  1604. X    DO 9600 I=1,12,3
  1605. X      TARGET=SCOLWL(I+1)
  1606. XC                        !ASSUME TARGET.
  1607. X      IF(SCOLWL(I).EQ.HERE) GO TO 2100
  1608. XC                        !TREAT IF FOUND.
  1609. X9600    CONTINUE
  1610. XC
  1611. X9700    IF(HERE.NE.BKBOX) GO TO 10
  1612. XC                        !IN BOX ROOM?
  1613. X    TARGET=WNORT
  1614. X    GO TO 2100
  1615. XC NOBJS, PAGE 7
  1616. XC
  1617. XC O41--    SHORT POLE
  1618. XC
  1619. X10000    IF(PRSA.NE.RAISEW) GO TO 10100
  1620. XC                        !LIFT?
  1621. X    I=749
  1622. XC                        !ASSUME UP.
  1623. X    IF(POLEUF.EQ.2) I=750
  1624. XC                        !ALREADY UP?
  1625. X    CALL RSPEAK(I)
  1626. X    POLEUF=2
  1627. XC                        !POLE IS RAISED.
  1628. X    RETURN
  1629. XC
  1630. X10100    IF((PRSA.NE.LOWERW).AND.(PRSA.NE.PUSHW)) GO TO 10
  1631. X    IF(POLEUF.NE.0) GO TO 10200
  1632. XC                        !ALREADY LOWERED?
  1633. X    CALL RSPEAK(751)
  1634. XC                        !CANT DO IT.
  1635. X    RETURN
  1636. XC
  1637. X10200    IF(MOD(MDIR,180).NE.0) GO TO 10300
  1638. XC                        !MIRROR N-S?
  1639. X    POLEUF=0
  1640. XC                        !YES, LOWER INTO
  1641. X    CALL RSPEAK(752)
  1642. XC                        !CHANNEL.
  1643. X    RETURN
  1644. XC
  1645. X10300    IF((MDIR.NE.270).OR.(MLOC.NE.MRB)) GO TO 10400
  1646. X    POLEUF=0
  1647. XC                        !LOWER INTO HOLE.
  1648. X    CALL RSPEAK(753)
  1649. X    RETURN
  1650. XC
  1651. X10400    CALL RSPEAK(753+POLEUF)
  1652. XC                        !POLEUF = 1 OR 2.
  1653. X    POLEUF=1
  1654. XC                        !NOW ON FLOOR.
  1655. X    RETURN
  1656. XC
  1657. XC O42--    MIRROR SWITCH
  1658. XC
  1659. X11000    IF(PRSA.NE.PUSHW) GO TO 10
  1660. XC                        !PUSH?
  1661. X    IF(MRPSHF) GO TO 11300
  1662. XC                        !ALREADY PUSHED?
  1663. X    CALL RSPEAK(756)
  1664. XC                        !BUTTON GOES IN.
  1665. X    DO 11100 I=1,OLNT
  1666. XC                        !BLOCKED?
  1667. X      IF(QHERE(I,MREYE).AND.(I.NE.RBEAM)) GO TO 11200
  1668. X11100    CONTINUE
  1669. X    CALL RSPEAK(757)
  1670. XC                        !NOTHING IN BEAM.
  1671. X    RETURN
  1672. XC
  1673. X11200    CFLAG(CEVMRS)=.TRUE.
  1674. XC                        !MIRROR OPENS.
  1675. X    CTICK(CEVMRS)=7
  1676. X    MRPSHF=.TRUE.
  1677. X    MROPNF=.TRUE.
  1678. X    RETURN
  1679. XC
  1680. X11300    CALL RSPEAK(758)
  1681. XC                        !MIRROR ALREADYOPEN.
  1682. X    RETURN
  1683. XC NOBJS, PAGE 8
  1684. XC
  1685. XC O43--    BEAM FUNCTION
  1686. XC
  1687. X12000    IF((PRSA.NE.TAKEW).OR.(PRSO.NE.RBEAM)) GO TO 12100
  1688. X    CALL RSPEAK(759)
  1689. XC                        !TAKE BEAM, JOKE.
  1690. X    RETURN
  1691. XC
  1692. X12100    I=PRSO
  1693. XC                        !ASSUME BLK WITH DIROBJ.
  1694. X    IF((PRSA.EQ.PUTW).AND.(PRSI.EQ.RBEAM)) GO TO 12200
  1695. X    IF((PRSA.NE.MUNGW).OR.(PRSO.NE.RBEAM).OR.
  1696. X&        (PRSI.EQ.0)) GO TO 10
  1697. X    I=PRSI
  1698. X12200    IF(OADV(I).NE.WINNER) GO TO 12300
  1699. XC                        !CARRYING?
  1700. X    CALL NEWSTA(I,0,HERE,0,0)
  1701. XC                        !DROP OBJ.
  1702. X    CALL RSPSUB(760,ODESC2(I))
  1703. X    RETURN
  1704. XC
  1705. X12300    J=761
  1706. XC                        !ASSUME NOT IN ROOM.
  1707. X    IF(QHERE(J,HERE)) I=762
  1708. XC                        !IN ROOM?
  1709. X    CALL RSPSUB(J,ODESC2(I))
  1710. XC                        !DESCRIBE.
  1711. X    RETURN
  1712. XC
  1713. XC O44--    BRONZE DOOR
  1714. XC
  1715. X13000    IF((HERE.EQ.NCELL).OR.((LCELL.EQ.4).AND.
  1716. X&        ((HERE.EQ.CELL).OR.(HERE.EQ.SCORR))))
  1717. X&        GO TO 13100
  1718. X    CALL RSPEAK(763)
  1719. XC                        !DOOR NOT THERE.
  1720. X    RETURN
  1721. XC
  1722. X13100    IF(.NOT.OPNCLS(ODOOR,764,765)) GO TO 10
  1723. XC                        !OPEN/CLOSE?
  1724. X    IF((HERE.EQ.NCELL).AND.QOPEN(ODOOR))
  1725. X&        CALL RSPEAK(766)
  1726. X    RETURN
  1727. XC
  1728. XC O45--    QUIZ DOOR
  1729. XC
  1730. X14000    IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 14100
  1731. X    CALL RSPEAK(767)
  1732. XC                        !DOOR WONT MOVE.
  1733. X    RETURN
  1734. XC
  1735. X14100    IF(PRSA.NE.KNOCKW) GO TO 10
  1736. XC                        !KNOCK?
  1737. X    IF(INQSTF) GO TO 14200
  1738. XC                        !TRIED IT ALREADY?
  1739. X    INQSTF=.TRUE.
  1740. XC                        !START INQUISITION.
  1741. X    CFLAG(CEVINQ)=.TRUE.
  1742. X    CTICK(CEVINQ)=2
  1743. X    QUESNO=RND(8)
  1744. XC                        !SELECT QUESTION.
  1745. X    NQATT=0
  1746. X    CORRCT=0
  1747. X    CALL RSPEAK(768)
  1748. XC                        !ANNOUNCE RULES.
  1749. X    CALL RSPEAK(769)
  1750. X    CALL RSPEAK(770+QUESNO)
  1751. XC                        !ASK QUESTION.
  1752. X    RETURN
  1753. XC
  1754. X14200    CALL RSPEAK(798)
  1755. XC                        !NO REPLY.
  1756. X    RETURN
  1757. XC
  1758. XC O46--    LOCKED DOOR
  1759. XC
  1760. X15000    IF(PRSA.NE.OPENW) GO TO 10
  1761. XC                        !OPEN?
  1762. X    CALL RSPEAK(778)
  1763. XC                        !CANT.
  1764. X    RETURN
  1765. XC
  1766. XC O47--    CELL DOOR
  1767. XC
  1768. X16000    NOBJS=OPNCLS(CDOOR,779,780)
  1769. XC                        !OPEN/CLOSE?
  1770. X    RETURN
  1771. XC NOBJS, PAGE 9
  1772. XC
  1773. XC O48--    DIALBUTTON
  1774. XC
  1775. X17000    IF(PRSA.NE.PUSHW) GO TO 10
  1776. XC                        !PUSH?
  1777. X    CALL RSPEAK(809)
  1778. XC                        !CLICK.
  1779. X    IF(QOPEN(CDOOR)) CALL RSPEAK(810)
  1780. XC                        !CLOSE CELL DOOR.
  1781. XC
  1782. X    DO 17100 I=1,OLNT
  1783. XC                        !RELOCATE OLD TO HYPER.
  1784. X      IF((OROOM(I).EQ.CELL).AND.(and(OFLAG1(I),DOORBT).EQ.0))
  1785. X&        CALL NEWSTA(I,0,LCELL*HFACTR,0,0)
  1786. X      IF(OROOM(I).EQ.(PNUMB*HFACTR))
  1787. X&        CALL NEWSTA(I,0,CELL,0,0)
  1788. X17100    CONTINUE
  1789. XC
  1790. X    OFLAG2(ODOOR)=and(OFLAG2(ODOOR), not(OPENBT))
  1791. X    OFLAG2(CDOOR)=and(OFLAG2(CDOOR), not(OPENBT))
  1792. X    OFLAG1(ODOOR)=and(OFLAG1(ODOOR), not(VISIBT))
  1793. X    IF(PNUMB.EQ.4) OFLAG1(ODOOR)=or(OFLAG1(ODOOR),VISIBT)
  1794. XC
  1795. X    IF(AROOM(PLAYER).NE.CELL) GO TO 17400
  1796. XC                        !PLAYER IN CELL?
  1797. X    IF(LCELL.NE.4) GO TO 17200
  1798. XC                        !IN RIGHT CELL?
  1799. X    OFLAG1(ODOOR)=or(OFLAG1(ODOOR), VISIBT)
  1800. X    F=MOVETO(NCELL,PLAYER)
  1801. XC                        !YES, MOVETO NCELL.
  1802. X    GO TO 17400
  1803. X17200    F=MOVETO(PCELL,PLAYER)
  1804. XC                        !NO, MOVETO PCELL.
  1805. XC
  1806. X17400    LCELL=PNUMB
  1807. X    RETURN
  1808. XC NOBJS, PAGE 10
  1809. XC
  1810. XC O49--    DIAL INDICATOR
  1811. XC
  1812. X18000    IF(PRSA.NE.SPINW) GO TO 18100
  1813. XC                        !SPIN?
  1814. X    PNUMB=RND(8)+1
  1815. XC                        !WHEE
  1816. XC                        !
  1817. X    CALL RSPSUB(797,712+PNUMB)
  1818. X    RETURN
  1819. XC
  1820. X18100    IF((PRSA.NE.MOVEW).AND.(PRSA.NE.PUTW).AND.
  1821. X&        (PRSA.NE.TRNTOW)) GO TO 10
  1822. X    IF(PRSI.NE.0) GO TO 18200
  1823. XC                        !TURN DIAL TO X?
  1824. X    CALL RSPEAK(806)
  1825. XC                        !MUST SPECIFY.
  1826. X    RETURN
  1827. XC
  1828. X18200    IF((PRSI.GE.NUM1).AND.(PRSI.LE.NUM8)) GO TO 18300
  1829. X    CALL RSPEAK(807)
  1830. XC                        !MUST BE DIGIT.
  1831. X    RETURN
  1832. XC
  1833. X18300    PNUMB=PRSI-NUM1+1
  1834. XC                        !SET UP NEW.
  1835. X    CALL RSPSUB(808,712+PNUMB)
  1836. X    RETURN
  1837. XC
  1838. XC O50--    GLOBAL MIRROR
  1839. XC
  1840. X19000    NOBJS=MIRPAN(832,.FALSE.)
  1841. X    RETURN
  1842. XC
  1843. XC O51--    GLOBAL PANEL
  1844. XC
  1845. X20000    IF(HERE.NE.FDOOR) GO TO 20100
  1846. XC                        !AT FRONT DOOR?
  1847. X    IF((PRSA.NE.OPENW).AND.(PRSA.NE.CLOSEW)) GO TO 10
  1848. X    CALL RSPEAK(843)
  1849. XC                        !PANEL IN DOOR, NOGO.
  1850. X    RETURN
  1851. XC
  1852. X20100    NOBJS=MIRPAN(838,.TRUE.)
  1853. X    RETURN
  1854. XC
  1855. XC O52--    PUZZLE ROOM SLIT
  1856. XC
  1857. X21000    IF((PRSA.NE.PUTW).OR.(PRSI.NE.CSLIT)) GO TO 10
  1858. X    IF(PRSO.NE.GCARD) GO TO 21100
  1859. XC                        !PUT CARD IN SLIT?
  1860. X    CALL NEWSTA(PRSO,863,0,0,0)
  1861. XC                        !KILL CARD.
  1862. X    CPOUTF=.TRUE.
  1863. XC                        !OPEN DOOR.
  1864. X    OFLAG1(STLDR)=and(OFLAG1(STLDR),not(VISIBT))
  1865. X    RETURN
  1866. XC
  1867. X21100    IF((and(OFLAG1(PRSO),VICTBT).EQ.0).AND.
  1868. X&      (and(OFLAG2(PRSO),VILLBT).EQ.0)) GO TO 21200
  1869. X    CALL RSPEAK(RND(5)+552)
  1870. XC                        !JOKE FOR VILL, VICT.
  1871. X    RETURN
  1872. XC
  1873. X21200    CALL NEWSTA(PRSO,0,0,0,0)
  1874. XC                        !KILL OBJECT.
  1875. X    CALL RSPSUB(864,ODO2)
  1876. XC                        !DESCRIBE.
  1877. X    RETURN
  1878. XC
  1879. X    END
  1880. XC MIRPAN--    PROCESSOR FOR GLOBAL MIRROR/PANEL
  1881. XC
  1882. XC DECLARATIONS
  1883. XC
  1884. X    LOGICAL FUNCTION MIRPAN(ST,PNF)
  1885. X    IMPLICIT INTEGER(A-Z)
  1886. X    LOGICAL PNF
  1887. X#include "gamestate.h"
  1888. X#include "parser.h"
  1889. X#include "verbs.h"
  1890. X#include "flags.h"
  1891. XC MIRPAN, PAGE 2
  1892. XC
  1893. X    MIRPAN=.TRUE.
  1894. X    NUM=MRHERE(HERE)
  1895. XC                        !GET MIRROR NUM.
  1896. X    IF(NUM.NE.0) GO TO 100
  1897. XC                        !ANY HERE?
  1898. X    CALL RSPEAK(ST)
  1899. XC                        !NO, LOSE.
  1900. X    RETURN
  1901. XC
  1902. X100    MRBF=0
  1903. XC                        !ASSUME MIRROR OK.
  1904. X    IF(((NUM.EQ.1).AND..NOT.MR1F).OR.
  1905. X&      ((NUM.EQ.2).AND..NOT.MR2F)) MRBF=1
  1906. X    IF((PRSA.NE.MOVEW).AND.(PRSA.NE.OPENW)) GO TO 200
  1907. X    CALL RSPEAK(ST+1)
  1908. XC                        !CANT OPEN OR MOVE.
  1909. X    RETURN
  1910. XC
  1911. X200    IF(PNF.OR.((PRSA.NE.LOOKIW).AND.(PRSA.NE.EXAMIW).AND.
  1912. X&        (PRSA.NE.LOOKW))) GO TO 300
  1913. X    CALL RSPEAK(844+MRBF)
  1914. XC                        !LOOK IN MIRROR.
  1915. X    RETURN
  1916. XC
  1917. X300    IF(PRSA.NE.MUNGW) GO TO 400
  1918. XC                        !BREAK?
  1919. X    CALL RSPEAK(ST+2+MRBF)
  1920. XC                        !DO IT.
  1921. X    IF((NUM.EQ.1).AND..NOT.PNF) MR1F=.FALSE.
  1922. X    IF((NUM.EQ.2).AND..NOT.PNF) MR2F=.FALSE.
  1923. X    RETURN
  1924. XC
  1925. X400    IF(PNF.OR.(MRBF.EQ.0)) GO TO 500
  1926. XC                        !BROKEN MIRROR?
  1927. X    CALL RSPEAK(846)
  1928. X    RETURN
  1929. XC
  1930. X500    IF(PRSA.NE.PUSHW) GO TO 600
  1931. XC                        !PUSH?
  1932. X    CALL RSPEAK(ST+3+NUM)
  1933. X    RETURN
  1934. XC
  1935. X600    MIRPAN=.FALSE.
  1936. XC                        !CANT HANDLE IT.
  1937. X    RETURN
  1938. XC
  1939. X    END
  1940. END_OF_nobjs.F
  1941. if test 13027 -ne `wc -c <nobjs.F`; then
  1942.     echo shar: \"nobjs.F\" unpacked with wrong size!
  1943. fi
  1944. # end of overwriting check
  1945. fi
  1946. if test -f sverbs.F -a "${1}" != "-c" ; then 
  1947.   echo shar: Will not over-write existing file \"sverbs.F\"
  1948. else
  1949. echo shar: Extracting \"sverbs.F\" \(13200 characters\)
  1950. sed "s/^X//" >sverbs.F <<'END_OF_sverbs.F'
  1951. XC SVERBS-    SIMPLE VERBS PROCESSOR
  1952. XC    ALL VERBS IN THIS ROUTINE MUST BE INDEPENDANT
  1953. XC    OF OBJECT ACTIONS
  1954. XC
  1955. XC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  1956. XC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  1957. XC WRITTEN BY R. M. SUPNIK
  1958. XC
  1959. XC DECLARATIONS
  1960. XC
  1961. X    LOGICAL FUNCTION SVERBS(RI)
  1962. X    IMPLICIT INTEGER (A-Z)
  1963. X    LOGICAL MOVETO,YESNO
  1964. X    LOGICAL RMDESC
  1965. X    LOGICAL QOPEN
  1966. X    LOGICAL FINDXT,QHERE,F
  1967. X    INTEGER JOKES(25)
  1968. X    CHARACTER ANSSTR(78)
  1969. X    CHARACTER P1(6),P2(6),CH(6)
  1970. X    INTEGER ANSWER(28)
  1971. X#include "parser.h"
  1972. X#include "gamestate.h"
  1973. X#include "state.h"
  1974. X#include "screen.h"
  1975. XC
  1976. XC MISCELLANEOUS VARIABLES
  1977. XC
  1978. X    CHARACTER VEDIT
  1979. X    COMMON /VERS/ VMAJ,VMIN,VEDIT
  1980. X#include "io.h"
  1981. X#include "rooms.h"
  1982. X#include "rflag.h"
  1983. X#include "rindex.h"
  1984. X#include "exits.h"
  1985. X#include "curxt.h"
  1986. X#include "xpars.h"
  1987. X#include "xsrch.h"
  1988. X#include "objects.h"
  1989. X#include "oflags.h"
  1990. X#include "oindex.h"
  1991. X#include "clock.h"
  1992. X
  1993. X#include "advers.h"
  1994. X#include "verbs.h"
  1995. X#include "flags.h"
  1996. XC
  1997. XC FUNCTIONS AND DATA
  1998. XC
  1999. X    QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
  2000. X    DATA MXNOP/39/,MXJOKE/64/
  2001. X    DATA JOKES/4,5,3,304,305,306,307,308,309,310,311,312,
  2002. X&        313,5314,5319,324,325,883,884,120,120,0,0,0,0/
  2003. X    DATA ANSWER/0,6,1,6,2,5,3,5,4,3,4,6,4,6,4,5,
  2004. X&        5,5,5,4,5,6,6,10,7,4,7,6/
  2005. X    DATA ANSSTR/'T','E','M','P','L','E',
  2006. X&        'F','O','R','E','S','T',
  2007. X&        '3','0','0','0','3',
  2008. X&        'F','L','A','S','K',
  2009. X&        'R','U','B',
  2010. X&        'F','O','N','D','L','E',
  2011. X&        'C','A','R','R','E','S',
  2012. X&        'T','O','U','C','H',
  2013. X&        'B','O','N','E','S',
  2014. X&        'B','O','D','Y',
  2015. X&        'S','K','E','L','E','T',
  2016. X&        'R','U','S','T','Y','K','N','I','F','E',
  2017. X&        'N','O','N','E',
  2018. X&        'N','O','W','H','E','R','\0'/
  2019. XC SVERBS, PAGE 2
  2020. XC
  2021. X    SVERBS=.TRUE.
  2022. XC                        !ASSUME WINS.
  2023. X    IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
  2024. XC                        !SET UP DESCRIPTORS.
  2025. X    IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
  2026. XC
  2027. X    IF(RI.EQ.0) CALL BUG(7,RI)
  2028. XC                        !ZERO IS VERBOTEN.
  2029. X    IF(RI.LE.MXNOP) RETURN
  2030. XC                        !NOP?
  2031. X    IF(RI.LE.MXJOKE) GO TO 100
  2032. XC                        !JOKE?
  2033. X    GO TO (65000,66000,67000,68000,69000,
  2034. X&     1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
  2035. X&     11000,12000,13000,14000,15000,16000,17000,18000,19000,20000,
  2036. X&     21000,22000,23000,24000,25000,26000,27000),
  2037. X&        (RI-MXJOKE)
  2038. X    CALL BUG(7,RI)
  2039. XC
  2040. XC ALL VERB PROCESSORS RETURN HERE TO DECLARE FAILURE.
  2041. XC
  2042. X10    SVERBS=.FALSE.
  2043. XC                        !LOSE.
  2044. X    RETURN
  2045. XC
  2046. XC JOKE PROCESSOR.
  2047. XC FIND PROPER ENTRY IN JOKES, USE IT TO SELECT STRING TO PRINT.
  2048. XC
  2049. X100    I=JOKES(RI-MXNOP)
  2050. XC                        !GET TABLE ENTRY.
  2051. X    J=I/1000
  2052. XC                        !ISOLATE # STRINGS.
  2053. X    IF(J.NE.0) I=MOD(I,1000)+RND(J)
  2054. XC                        !IF RANDOM, CHOOSE.
  2055. X    CALL RSPEAK(I)
  2056. XC                        !PRINT JOKE.
  2057. X    RETURN
  2058. XC SVERBS, PAGE 2A
  2059. XC
  2060. XC V65--    ROOM
  2061. XC
  2062. X65000    SVERBS=RMDESC(2)
  2063. XC                        !DESCRIBE ROOM ONLY.
  2064. X    RETURN
  2065. XC
  2066. XC V66--    OBJECTS
  2067. XC
  2068. X66000    SVERBS=RMDESC(1)
  2069. XC                        !DESCRIBE OBJ ONLY.
  2070. X    IF(.NOT.TELFLG) CALL RSPEAK(138)
  2071. XC                        !NO OBJECTS.
  2072. X    RETURN
  2073. XC
  2074. XC V67--    RNAME
  2075. XC
  2076. X67000    CALL RSPEAK(RDESC2-HERE)
  2077. XC                        !SHORT ROOM NAME.
  2078. X    RETURN
  2079. XC
  2080. XC V68--    RESERVED
  2081. XC
  2082. X68000    RETURN
  2083. XC
  2084. XC V69--    RESERVED
  2085. XC
  2086. X69000    RETURN
  2087. XC SVERBS, PAGE 3
  2088. XC
  2089. XC V70--    BRIEF.  SET FLAG.
  2090. XC
  2091. X1000    BRIEFF=.TRUE.
  2092. XC                        !BRIEF DESCRIPTIONS.
  2093. X    SUPERF=.FALSE.
  2094. X    CALL RSPEAK(326)
  2095. X    RETURN
  2096. XC
  2097. XC V71--    VERBOSE.  CLEAR FLAGS.
  2098. XC
  2099. X2000    BRIEFF=.FALSE.
  2100. XC                        !LONG DESCRIPTIONS.
  2101. X    SUPERF=.FALSE.
  2102. X    CALL RSPEAK(327)
  2103. X    RETURN
  2104. XC
  2105. XC V72--    SUPERBRIEF.  SET FLAG.
  2106. XC
  2107. X3000    SUPERF=.TRUE.
  2108. X    CALL RSPEAK(328)
  2109. X    RETURN
  2110. XC
  2111. XC V73-- STAY (USED IN ENDGAME).
  2112. XC
  2113. X4000    IF(WINNER.NE.AMASTR) GO TO 4100
  2114. XC                        !TELL MASTER, STAY.
  2115. X    CALL RSPEAK(781)
  2116. XC                        !HE DOES.
  2117. X    CTICK(CEVFOL)=0
  2118. XC                        !NOT FOLLOWING.
  2119. X    RETURN
  2120. XC
  2121. X4100    IF(WINNER.EQ.PLAYER) CALL RSPEAK(664)
  2122. XC                        !JOKE.
  2123. X    RETURN
  2124. XC
  2125. XC V74--    VERSION.  PRINT INFO.
  2126. XC
  2127. X#ifdef PDP
  2128. X5000    call prvers(vmaj,vmin,vedit)
  2129. X#else
  2130. X5000    WRITE(OUTCH,5010) VMAJ,VMIN,VEDIT
  2131. X5010    FORMAT(' V',I1,'.',I2,A1)
  2132. X#endif PDP
  2133. X    TELFLG=.TRUE.
  2134. X    RETURN
  2135. XC
  2136. XC V75--    SWIM.  ALWAYS A JOKE.
  2137. XC
  2138. X6000    I=330
  2139. XC                        !ASSUME WATER.
  2140. X    IF(and(RFLAG(HERE),(RWATER+RFILL)).EQ.0)
  2141. X&        I=331+RND(3)
  2142. X    CALL RSPEAK(I)
  2143. X    RETURN
  2144. XC
  2145. XC V76--    GERONIMO.  IF IN BARREL, FATAL, ELSE JOKE.
  2146. XC
  2147. X7000    IF(HERE.EQ.MBARR) GO TO 7100
  2148. XC                        !IN BARREL?
  2149. X    CALL RSPEAK(334)
  2150. XC                        !NO, JOKE.
  2151. X    RETURN
  2152. XC
  2153. X7100    CALL JIGSUP(335)
  2154. XC                        !OVER FALLS.
  2155. X    RETURN
  2156. XC
  2157. XC V77--    SINBAD ET AL.  CHASE CYCLOPS, ELSE JOKE.
  2158. XC
  2159. X8000    IF((HERE.EQ.MCYCL).AND.QHERE(CYCLO,HERE)) GO TO 8100
  2160. X    CALL RSPEAK(336)
  2161. XC                        !NOT HERE, JOKE.
  2162. X    RETURN
  2163. XC
  2164. X8100    CALL NEWSTA(CYCLO,337,0,0,0)
  2165. XC                        !CYCLOPS FLEES.
  2166. X    CYCLOF=.TRUE.
  2167. XC                        !SET ALL FLAGS.
  2168. X    MAGICF=.TRUE.
  2169. X    OFLAG2(CYCLO)=and(OFLAG2(CYCLO), not(FITEBT))
  2170. X    RETURN
  2171. XC
  2172. XC V78--    WELL.  OPEN DOOR, ELSE JOKE.
  2173. XC
  2174. X9000    IF(RIDDLF.OR.(HERE.NE.RIDDL)) GO TO 9100
  2175. XC                        !IN RIDDLE ROOM?
  2176. X    RIDDLF=.TRUE.
  2177. XC                        !YES, SOLVED IT.
  2178. X    CALL RSPEAK(338)
  2179. X    RETURN
  2180. XC
  2181. X9100    CALL RSPEAK(339)
  2182. XC                        !WELL, WHAT?
  2183. X    RETURN
  2184. XC
  2185. XC V79--    PRAY.  IF IN TEMP2, POOF
  2186. XC                        !
  2187. XC
  2188. X10000    IF(HERE.NE.TEMP2) GO TO 10050
  2189. XC                        !IN TEMPLE?
  2190. X    IF(MOVETO(FORE1,WINNER)) GO TO 10100
  2191. XC                        !FORE1 STILL THERE?
  2192. X10050    CALL RSPEAK(340)
  2193. XC                        !JOKE.
  2194. X    RETURN
  2195. XC
  2196. X10100    F=RMDESC(3)
  2197. XC                        !MOVED, DESCRIBE.
  2198. X    RETURN
  2199. XC
  2200. XC V80--    TREASURE.  IF IN TEMP1, POOF
  2201. XC                        !
  2202. XC
  2203. X11000    IF(HERE.NE.TEMP1) GO TO 11050
  2204. XC                        !IN TEMPLE?
  2205. X    IF(MOVETO(TREAS,WINNER)) GO TO 10100
  2206. XC                        !TREASURE ROOM THERE?
  2207. X11050    CALL RSPEAK(341)
  2208. XC                        !NOTHING HAPPENS.
  2209. X    RETURN
  2210. XC
  2211. XC V81--    TEMPLE.  IF IN TREAS, POOF
  2212. XC                        !
  2213. XC
  2214. X12000    IF(HERE.NE.TREAS) GO TO 12050
  2215. XC                        !IN TREASURE?
  2216. X    IF(MOVETO(TEMP1,WINNER)) GO TO 10100
  2217. XC                        !TEMP1 STILL THERE?
  2218. X12050    CALL RSPEAK(341)
  2219. XC                        !NOTHING HAPPENS.
  2220. X    RETURN
  2221. XC
  2222. XC V82--    BLAST.  USUALLY A JOKE.
  2223. XC
  2224. X13000    I=342
  2225. XC                        !DONT UNDERSTAND.
  2226. X    IF(PRSO.EQ.SAFE) I=252
  2227. XC                        !JOKE FOR SAFE.
  2228. X    CALL RSPEAK(I)
  2229. X    RETURN
  2230. XC
  2231. XC V83--    SCORE.  PRINT SCORE.
  2232. XC
  2233. X14000    CALL SCORE(.FALSE.)
  2234. X    RETURN
  2235. XC
  2236. XC V84--    QUIT.  FINISH OUT THE GAME.
  2237. XC
  2238. X15000    CALL SCORE(.TRUE.)
  2239. XC                        !TELLL SCORE.
  2240. X    IF(.NOT.YESNO(343,0,0)) RETURN
  2241. XC                        !ASK FOR Y/N DECISION.
  2242. X#ifdef PDP
  2243. XC    close routine moved to exit for pdp version
  2244. X#else
  2245. X    CLOSE (DBCH)
  2246. X#endif PDP
  2247. X    CALL EXIT
  2248. XC                        !BYE.
  2249. XC SVERBS, PAGE 4
  2250. XC
  2251. XC V85--    FOLLOW (USED IN ENDGAME)
  2252. XC
  2253. X16000    IF(WINNER.NE.AMASTR) RETURN
  2254. XC                        !TELL MASTER, FOLLOW.
  2255. X    CALL RSPEAK(782)
  2256. X    CTICK(CEVFOL)=-1
  2257. XC                        !STARTS FOLLOWING.
  2258. X    RETURN
  2259. XC
  2260. XC V86--    WALK THROUGH
  2261. XC
  2262. X17000    IF((SCOLRM.EQ.0).OR.((PRSO.NE.SCOL).AND.
  2263. X&        ((PRSO.NE.WNORT).OR.(HERE.NE.BKBOX)))) GO TO 17100
  2264. X    SCOLAC=SCOLRM
  2265. XC                        !WALKED THRU SCOL.
  2266. X    PRSO=0
  2267. XC                        !FAKE OUT FROMDR.
  2268. X    CTICK(CEVSCL)=6
  2269. XC                        !START ALARM.
  2270. X    CALL RSPEAK(668)
  2271. XC                        !DISORIENT HIM.
  2272. X    F=MOVETO(SCOLRM,WINNER)
  2273. XC                        !INTO ROOM.
  2274. X    F=RMDESC(3)
  2275. XC                        !DESCRIBE.
  2276. X    RETURN
  2277. XC
  2278. X17100    IF(HERE.NE.SCOLAC) GO TO 17300
  2279. XC                        !ON OTHER SIDE OF SCOL?
  2280. X    DO 17200 I=1,12,3
  2281. XC                        !WALK THRU PROPER WALL?
  2282. X      IF((SCOLWL(I).EQ.HERE).AND.(SCOLWL(I+1).EQ.PRSO))
  2283. X&        GO TO 17500
  2284. X17200    CONTINUE
  2285. XC
  2286. X17300    IF(and(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 17400
  2287. X    I=669
  2288. XC                        !NO, JOKE.
  2289. X    IF(PRSO.EQ.SCOL) I=670
  2290. XC                        !SPECIAL JOKE FOR SCOL.
  2291. X    CALL RSPSUB(I,ODO2)
  2292. X    RETURN
  2293. XC
  2294. X17400    I=671
  2295. XC                        !JOKE.
  2296. X    IF(OROOM(PRSO).NE.0) I=552+RND(5)
  2297. XC                        !SPECIAL JOKES IF CARRY.
  2298. X    CALL RSPEAK(I)
  2299. X    RETURN
  2300. XC
  2301. X17500    PRSO=SCOLWL(I+2)
  2302. XC                        !THRU SCOL WALL...
  2303. X    DO 17600 I=1,8,2
  2304. XC                        !FIND MATCHING ROOM.
  2305. X      IF(PRSO.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1)
  2306. X17600    CONTINUE
  2307. XC                        !DECLARE NEW SCOLRM.
  2308. X    CTICK(CEVSCL)=0
  2309. XC                        !CANCEL ALARM.
  2310. X    CALL RSPEAK(668)
  2311. XC                        !DISORIENT HIM.
  2312. X    F=MOVETO(BKBOX,WINNER)
  2313. XC                        !BACK IN BOX ROOM.
  2314. X    F=RMDESC(3)
  2315. X    RETURN
  2316. XC
  2317. XC V87--    RING.  A JOKE.
  2318. XC
  2319. X18000    I=359
  2320. XC                        !CANT RING.
  2321. X    IF(PRSO.EQ.BELL) I=360
  2322. XC                        !DING, DONG.
  2323. X    CALL RSPEAK(I)
  2324. XC                        !JOKE.
  2325. X    RETURN
  2326. XC
  2327. XC V88--    BRUSH.  JOKE WITH OBSCURE TRAP.
  2328. XC
  2329. X19000    IF(PRSO.EQ.TEETH) GO TO 19100
  2330. XC                        !BRUSH TEETH?
  2331. X    CALL RSPEAK(362)
  2332. XC                        !NO, JOKE.
  2333. X    RETURN
  2334. XC
  2335. X19100    IF(PRSI.NE.0) GO TO 19200
  2336. XC                        !WITH SOMETHING?
  2337. X    CALL RSPEAK(363)
  2338. XC                        !NO, JOKE.
  2339. X    RETURN
  2340. XC
  2341. X19200    IF((PRSI.EQ.PUTTY).AND.(OADV(PUTTY).EQ.WINNER))
  2342. X&        GO TO 19300
  2343. X    CALL RSPSUB(364,ODI2)
  2344. XC                        !NO, JOKE.
  2345. X    RETURN
  2346. XC
  2347. X19300    CALL JIGSUP(365)
  2348. XC                        !YES, DEAD
  2349. XC                        !
  2350. XC                        !
  2351. XC                        !
  2352. XC                        !
  2353. XC                        !
  2354. X    RETURN
  2355. XC SVERBS, PAGE 5
  2356. XC
  2357. XC V89--    DIG.  UNLESS SHOVEL, A JOKE.
  2358. XC
  2359. X20000    IF(PRSO.EQ.SHOVE) RETURN
  2360. XC                        !SHOVEL?
  2361. X    I=392
  2362. XC                        !ASSUME TOOL.
  2363. X    IF(and(OFLAG1(PRSO),TOOLBT).EQ.0) I=393
  2364. X    CALL RSPSUB(I,ODO2)
  2365. X    RETURN
  2366. XC
  2367. XC V90--    TIME.  PRINT OUT DURATION OF GAME.
  2368. XC
  2369. X#ifdef PDP
  2370. XC    no duration time available for pdp version (removed
  2371. XC    to make things fit)
  2372. X21000    TELFLG=.TRUE.
  2373. X    RETURN
  2374. X#else
  2375. X21000    CALL GTTIME(K)
  2376. XC                        !GET PLAY TIME.
  2377. X    I=K/60
  2378. X    J=MOD(K,60)
  2379. XC
  2380. X    WRITE(OUTCH,21010)
  2381. X    IF(I.NE.0) WRITE(OUTCH,21011) I
  2382. X    IF(I.GE.2) WRITE(OUTCH,21012)
  2383. X    IF(I.EQ.1) WRITE(OUTCH,21013)
  2384. X    IF(J.EQ.1) WRITE(OUTCH,21014) J
  2385. X    IF(J.NE.1) WRITE(OUTCH,21015) J
  2386. X    TELFLG=.TRUE.
  2387. X    RETURN
  2388. XC
  2389. X21010    FORMAT(' You have been playing Dungeon for ',$)
  2390. X21011    FORMAT('+',I3,' hour',$)
  2391. X21012    FORMAT('+s and ',$)
  2392. X21013    FORMAT('+ and ',$)
  2393. X21014    FORMAT('+',I2,' minute.')
  2394. X21015    FORMAT('+',I2,' minutes.')
  2395. X#endif PDP
  2396. XC
  2397. XC V91--    LEAP.  USUALLY A JOKE, WITH A CATCH.
  2398. XC
  2399. X22000    IF(PRSO.EQ.0) GO TO 22200
  2400. XC                        !OVER SOMETHING?
  2401. X    IF(QHERE(PRSO,HERE)) GO TO 22100
  2402. XC                        !HERE?
  2403. X    CALL RSPEAK(447)
  2404. XC                        !NO, JOKE.
  2405. X    RETURN
  2406. XC
  2407. X22100    IF(and(OFLAG2(PRSO),VILLBT).EQ.0) GO TO 22300
  2408. X    CALL RSPSUB(448,ODO2)
  2409. XC                        !CANT JUMP VILLAIN.
  2410. X    RETURN
  2411. XC
  2412. X22200    IF(.NOT.FINDXT(XDOWN,HERE)) GO TO 22300
  2413. XC                        !DOWN EXIT?
  2414. X    IF((XTYPE.EQ.XNO).OR.((XTYPE.EQ.XCOND).AND.
  2415. X&        .NOT.FLAGS(XFLAG))) GO TO 22400
  2416. X22300    CALL RSPEAK(314+RND(5))
  2417. XC                        !WHEEEE
  2418. XC                        !
  2419. X    RETURN
  2420. XC
  2421. X22400    CALL JIGSUP(449+RND(4))
  2422. XC                        !FATAL LEAP.
  2423. X    RETURN
  2424. XC SVERBS, PAGE 6
  2425. XC
  2426. XC V92--    LOCK.
  2427. XC
  2428. X23000    IF((PRSO.EQ.GRATE).AND.(HERE.EQ.MGRAT))
  2429. X&        GO TO 23200
  2430. X23100    CALL RSPEAK(464)
  2431. XC                        !NOT LOCK GRATE.
  2432. X    RETURN
  2433. XC
  2434. X23200    GRUNLF=.FALSE.
  2435. XC                        !GRATE NOW LOCKED.
  2436. X    CALL RSPEAK(214)
  2437. X    TRAVEL(REXIT(HERE)+1)=214
  2438. XC                        !CHANGE EXIT STATUS.
  2439. X    RETURN
  2440. XC
  2441. XC V93--    UNLOCK
  2442. XC
  2443. X24000    IF((PRSO.NE.GRATE).OR.(HERE.NE.MGRAT))
  2444. X&        GO TO 23100
  2445. X    IF(PRSI.EQ.KEYS) GO TO 24200
  2446. XC                        !GOT KEYS?
  2447. X    CALL RSPSUB(465,ODI2)
  2448. XC                        !NO, JOKE.
  2449. X    RETURN
  2450. XC
  2451. X24200    GRUNLF=.TRUE.
  2452. XC                        !UNLOCK GRATE.
  2453. X    CALL RSPEAK(217)
  2454. X    TRAVEL(REXIT(HERE)+1)=217
  2455. XC                        !CHANGE EXIT STATUS.
  2456. X    RETURN
  2457. XC
  2458. XC V94--    DIAGNOSE.
  2459. XC
  2460. X25000    I=FIGHTS(WINNER,.FALSE.)
  2461. XC                        !GET FIGHTS STRENGTH.
  2462. X    J=ASTREN(WINNER)
  2463. XC                        !GET HEALTH.
  2464. X    K=MIN0(I+J,4)
  2465. XC                        !GET STATE.
  2466. X    IF(.NOT.CFLAG(CEVCUR)) J=0
  2467. XC                        !IF NO WOUNDS.
  2468. X    L=MIN0(4,IABS(J))
  2469. XC                        !SCALE.
  2470. X    CALL RSPEAK(473+L)
  2471. XC                        !DESCRIBE HEALTH.
  2472. X    I=(30*(-J-1))+CTICK(CEVCUR)
  2473. XC                        !COMPUTE WAIT.
  2474. XC
  2475. X#ifdef PDP
  2476. X    if(J .ne. 0) call cured(I)
  2477. X#else
  2478. X     IF(J.NE.0) WRITE(OUTCH,25100) I
  2479. X25100    FORMAT(' You will be cured after ',I3,' moves.')
  2480. X#endif PDP
  2481. XC
  2482. X    CALL RSPEAK(478+K)
  2483. XC                        !HOW MUCH MORE?
  2484. X    IF(DEATHS.NE.0) CALL RSPEAK(482+DEATHS)
  2485. XC                        !HOW MANY DEATHS?
  2486. X    RETURN
  2487. XC SVERBS, PAGE 7
  2488. XC
  2489. XC V95--    INCANT
  2490. XC
  2491. X26000    DO 26100 I=1,6
  2492. XC                        !SET UP PARSE.
  2493. X      P1(I)=' '
  2494. X      P2(I)=' '
  2495. X26100    CONTINUE
  2496. X    WP=1
  2497. XC                        !WORD POINTER.
  2498. X    CP=1
  2499. XC                        !CHAR POINTER.
  2500. X    IF(PRSCON.LE.1) GO TO 26300
  2501. X    DO 26200 I=PRSCON,INLNT
  2502. XC                        !PARSE INPUT
  2503. X      IF(INBUF(I).EQ.',') GO TO 26300
  2504. XC                        !END OF PHRASE?
  2505. X      IF(INBUF(I).NE.' ') GO TO 26150
  2506. XC                        !SPACE?
  2507. X      IF(CP.NE.1) WP=WP+1
  2508. X      CP=1
  2509. X      GO TO 26200
  2510. X26150      IF(WP.EQ.1) P1(CP)=INBUF(I)
  2511. XC                        !STUFF INTO HOLDER.
  2512. X      IF(WP.EQ.2) P2(CP)=INBUF(I)
  2513. X      CP=MIN0(CP+1,6)
  2514. X26200    CONTINUE
  2515. XC
  2516. X26300    PRSCON=1
  2517. XC                        !KILL REST OF LINE.
  2518. X    IF(P1(1).NE.' ') GO TO 26400
  2519. XC                        !ANY INPUT?
  2520. X    CALL RSPEAK(856)
  2521. XC                        !NO, HO HUM.
  2522. X    RETURN
  2523. XC
  2524. X26400    CALL ENCRYP(P1,CH)
  2525. XC                        !COMPUTE RESPONSE.
  2526. X    IF(P2(1).NE.' ') GO TO 26600
  2527. XC                        !TWO PHRASES?
  2528. XC
  2529. X    IF(SPELLF) GO TO 26550
  2530. XC                        !HE'S TRYING TO LEARN.
  2531. X    IF(and(RFLAG(TSTRS),RSEEN).EQ.0) GO TO 26575
  2532. X    SPELLF=.TRUE.
  2533. XC                        !TELL HIM.
  2534. X    TELFLG=.TRUE.
  2535. X#ifdef PDP
  2536. X    call voice(P1,CH)
  2537. X#else
  2538. X     WRITE(OUTCH,26510) P1,CH
  2539. X26510    FORMAT(' A hollow voice replies:  "',6A1,1X,6A1,'".')
  2540. X#endif PDP
  2541. XC
  2542. X    RETURN
  2543. XC
  2544. X26550    CALL RSPEAK(857)
  2545. XC                        !HE'S GOT ONE ALREADY.
  2546. X    RETURN
  2547. XC
  2548. X26575    CALL RSPEAK(858)
  2549. XC                        !HE'S NOT IN ENDGAME.
  2550. X    RETURN
  2551. XC
  2552. X26600    IF(and(RFLAG(TSTRS),RSEEN).NE.0) GO TO 26800
  2553. X    DO 26700 I=1,6
  2554. X      IF(P2(I).NE.CH(I)) GO TO 26575
  2555. XC                        !WRONG.
  2556. X26700    CONTINUE
  2557. X    SPELLF=.TRUE.
  2558. XC                        !IT WORKS.
  2559. X    CALL RSPEAK(859)
  2560. X    CTICK(CEVSTE)=1
  2561. XC                        !FORCE START.
  2562. X    RETURN
  2563. XC
  2564. X26800    CALL RSPEAK(855)
  2565. XC                        !TOO LATE.
  2566. X    RETURN
  2567. XC SVERBS, PAGE 8
  2568. XC
  2569. XC V96--    ANSWER
  2570. XC
  2571. X27000    IF((PRSCON.GT.1).AND.
  2572. X&        (HERE.EQ.FDOOR).AND.INQSTF)
  2573. X&        GO TO 27100
  2574. X    CALL RSPEAK(799)
  2575. XC                        !NO ONE LISTENS.
  2576. X    PRSCON=1
  2577. X    RETURN
  2578. XC
  2579. X27100    K=1
  2580. XC                        !POINTER INTO ANSSTR.
  2581. X    DO 27300 J=1,28,2
  2582. XC                        !CHECK ANSWERS.
  2583. X      NEWK=K+ANSWER(J+1)
  2584. XC                        !COMPUTE NEXT K.
  2585. X      IF(QUESNO.NE.ANSWER(J)) GO TO 27300
  2586. XC                        !ONLY CHECK PROPER ANS.
  2587. X      I=PRSCON-1
  2588. XC                        !SCAN ANSWER.
  2589. X      DO 27200 L=K,NEWK-1
  2590. X27150        I=I+1
  2591. XC                        !SKIP INPUT BLANKS.
  2592. X        IF(I.GT.INLNT) GO TO 27300
  2593. XC                        !END OF INPUT? LOSE.
  2594. X        IF(INBUF(I).EQ.' ') GO TO 27150
  2595. X        IF(INBUF(I).NE.ANSSTR(L)) GO TO 27300
  2596. X27200      CONTINUE
  2597. X      GO TO 27500
  2598. XC                        !RIGHT ANSWER.
  2599. X27300    K=NEWK
  2600. XC
  2601. X    PRSCON=1
  2602. XC                        !KILL REST OF LINE.
  2603. X    NQATT=NQATT+1
  2604. XC                        !WRONG, CRETIN.
  2605. X    IF(NQATT.GE.5) GO TO 27400
  2606. XC                        !TOO MANY WRONG?
  2607. X    CALL RSPEAK(800+NQATT)
  2608. XC                        !NO, TRY AGAIN.
  2609. X    RETURN
  2610. XC
  2611. X27400    CALL RSPEAK(826)
  2612. XC                        !ALL OVER.
  2613. X    CFLAG(CEVINQ)=.FALSE.
  2614. XC                        !LOSE.
  2615. X    RETURN
  2616. XC
  2617. X27500    PRSCON=1
  2618. XC                        !KILL REST OF LINE.
  2619. X    CORRCT=CORRCT+1
  2620. XC                        !GOT IT RIGHT.
  2621. X    CALL RSPEAK(800)
  2622. XC                        !HOORAY.
  2623. X    IF(CORRCT.GE.3) GO TO 27600
  2624. XC                        !WON TOTALLY?
  2625. X    CTICK(CEVINQ)=2
  2626. XC                        !NO, START AGAIN.
  2627. X    QUESNO=MOD(QUESNO+3,8)
  2628. X    NQATT=0
  2629. X    CALL RSPEAK(769)
  2630. XC                        !ASK NEXT QUESTION.
  2631. X    CALL RSPEAK(770+QUESNO)
  2632. X    RETURN
  2633. XC
  2634. X27600    CALL RSPEAK(827)
  2635. XC                        !QUIZ OVER,
  2636. X    CFLAG(CEVINQ)=.FALSE.
  2637. X    OFLAG2(QDOOR)=or(OFLAG2(QDOOR),OPENBT)
  2638. X    RETURN
  2639. XC
  2640. X    END
  2641. END_OF_sverbs.F
  2642. if test 13200 -ne `wc -c <sverbs.F`; then
  2643.     echo shar: \"sverbs.F\" unpacked with wrong size!
  2644. fi
  2645. # end of overwriting check
  2646. fi
  2647. echo shar: End of archive 4 \(of 7\).
  2648. cp /dev/null ark4isdone
  2649. MISSING=""
  2650. for I in 1 2 3 4 5 6 7 ; do
  2651.     if test ! -f ark${I}isdone ; then
  2652.     MISSING="${MISSING} ${I}"
  2653.     fi
  2654. done
  2655. if test "${MISSING}" = "" ; then
  2656.     echo You have unpacked all 7 archives.
  2657.     rm -f ark[1-9]isdone
  2658. else
  2659.     echo You still need to unpack the following archives:
  2660.     echo "        " ${MISSING}
  2661. fi
  2662. ##  End of shell archive.
  2663. exit 0
  2664.